Skip to content

Commit 93d5eb8

Browse files
committed
Replace every use of GNU Patch by the OCaml patch library
1 parent fa93c54 commit 93d5eb8

21 files changed

+241
-98
lines changed

.github/workflows/ci.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -527,8 +527,8 @@ let main oc : unit =
527527
("OPAM12CACHE", "~/.cache/opam1.2/cache");
528528
(* These should be identical to the values in appveyor.yml *)
529529
("OPAM_REPO", "https://github.com/ocaml/opam-repository.git");
530-
("OPAM_TEST_REPO_SHA", "67e940587b8aca227f511e1943bcd31eabe6b1db");
531-
("OPAM_REPO_SHA", "67e940587b8aca227f511e1943bcd31eabe6b1db");
530+
("OPAM_TEST_REPO_SHA", "0c42e982f4cf97fc698132fb2a16b49524a26ab3");
531+
("OPAM_REPO_SHA", "0c42e982f4cf97fc698132fb2a16b49524a26ab3");
532532
("SOLVER", "");
533533
(* Cygwin configuration *)
534534
("CYGWIN_MIRROR", "http://mirrors.kernel.org/sourceware/cygwin/");

.github/workflows/main.yml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -26,8 +26,8 @@ env:
2626
OPAMBSROOT: ~/.cache/.opam.cached
2727
OPAM12CACHE: ~/.cache/opam1.2/cache
2828
OPAM_REPO: https://github.com/ocaml/opam-repository.git
29-
OPAM_TEST_REPO_SHA: 67e940587b8aca227f511e1943bcd31eabe6b1db
30-
OPAM_REPO_SHA: 67e940587b8aca227f511e1943bcd31eabe6b1db
29+
OPAM_TEST_REPO_SHA: 0c42e982f4cf97fc698132fb2a16b49524a26ab3
30+
OPAM_REPO_SHA: 0c42e982f4cf97fc698132fb2a16b49524a26ab3
3131
SOLVER:
3232
CYGWIN_MIRROR: http://mirrors.kernel.org/sourceware/cygwin/
3333
CYGWIN_ROOT: D:\cygwin

configure

Lines changed: 30 additions & 4 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

configure.ac

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -366,6 +366,7 @@ AC_CHECK_OCAML_PKG([jsonm])
366366
AC_CHECK_OCAML_PKG([uutf])
367367
AC_CHECK_OCAML_PKG([sha])
368368
AC_CHECK_OCAML_PKG([swhid_core])
369+
AC_CHECK_OCAML_PKG([patch])
369370

370371
# Optional dependencies
371372
AC_CHECK_OCAML_PKG_AT_LEAST([mccs],[1.1+17])
@@ -414,6 +415,7 @@ AS_IF([test "x${enable_checks}" != "xno" && {
414415
test "x$OCAML_PKG_uutf" = "xno" ||
415416
test "x$OCAML_PKG_sha" = "xno" ||
416417
test "x$OCAML_PKG_swhid_core" = "xno" ||
418+
test "x$OCAML_PKG_patch" = "xno" ||
417419
test "x$OCAML_PKG_mccs$MCCS_ENABLED" = "xnotrue";}],[
418420
AS_IF([test "x${with_vendored_deps}" != "xyes"],[
419421
AC_MSG_ERROR([Dependencies missing. Use --with-vendored-deps or --disable-checks])

master_changes.md

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -29,6 +29,9 @@ users)
2929
## Install
3030

3131
## Build (package)
32+
* Patches are now applied using the `patch` OCaml library instead of GNU Patch [#5892 @kit-ty-kate - fix #6019]
33+
* ✘ Patches: Context diffs are not supported anymore, only Unified diffs are (including its git extensions) [#5892 @kit-ty-kate]
34+
* ✘ Patches: Stop support of file permission changes via git extension to the unified diff specification [#5892 @kit-ty-kate - fix #3782]
3235

3336
## Remove
3437

@@ -64,6 +67,7 @@ users)
6467
* [BUG] Do not show the not-up-to-date message with packages tagged with avoid-version [#6273 @kit-ty-kate - fix #6271]
6568
* [BUG] Fix a regression on `opam upgrade <package>` upgrading unrelated packages [#6373 @AltGr]
6669
* [BUG] Fix a regression on `opam upgrade --all <uninstalled-pkg>` not upgrading the whole switch [#6373 @kit-ty-kate]
70+
* Updates are now applied using the `patch` OCaml library instead of the system GNU Patch and diff utilities [#5892 @kit-ty-kate - fix ocaml/setup-ocaml#933]
6771

6872
## Tree
6973

@@ -82,6 +86,7 @@ users)
8286
* Update SWH API request [#6036 @rjbou]
8387
* Rework SWH fallback to have a more correct archive retrieval and more fine grained error handling [#6036 @rjbou - fix #5721]
8488
* Check that the repositories given to `opam repository remove` actually exist [#5014 @kit-ty-kate - fixes #5012]
89+
* ✘ Symlinks in repositories are no longer supported [#5892 @kit-ty-kate]
8590

8691
## Lock
8792
* [BUG] Fix `pin-depends` for `with-*` dependencies [#5471 @rjbou - fix #5428]
@@ -99,6 +104,7 @@ users)
99104
* Lookup at `gpatch` before `patch` on macOS now that both homebrew and macports expose `gpatch` as `gpatch` since Homebrew/homebrew-core#174687 [#6255 @kit-ty-kate]
100105
* Relax lookup on OpenBSD to consider all installed packages [#6362 @semarie]
101106
* Speedup the detection of available system packages with pacman and brew [#6324 @kit-ty-kate]
107+
* The system GNU Patch and diff are no longer runtime dependencies of opam [#5892 @kit-ty-kate]
102108

103109
## Format upgrade
104110

opam-core.opam

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -30,6 +30,7 @@ depends: [
3030
"sha" {>= "1.13"}
3131
"jsonm"
3232
"swhid_core"
33+
"patch" {>= "3.0.0~alpha1"}
3334
"uutf"
3435
(("host-system-mingw" {os = "win32" & os-distribution != "cygwinports"} &
3536
"conf-mingw-w64-gcc-i686" {os = "win32" & os-distribution != "cygwinports"} &

opam-repository.opam

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -30,5 +30,6 @@ build: [
3030
depends: [
3131
"ocaml" {>= "4.08.0"}
3232
"opam-format" {= version}
33+
"patch" {>= "3.0.0~alpha1"}
3334
"dune" {>= "2.8.0"}
3435
]

src/client/opamAction.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -368,7 +368,7 @@ let prepare_package_build env opam nv dir =
368368
let apply_patches ?(dryrun=false) () =
369369
let patch base =
370370
if dryrun then Done None else
371-
OpamFilename.patch
371+
OpamFilename.patch ~allow_unclean:true
372372
(dir // OpamFilename.Base.to_string base) dir
373373
in
374374
let rec aux = function

src/client/opamInitDefaults.ml

Lines changed: 0 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -52,11 +52,6 @@ let not_win32_filter =
5252
FOp (FIdent ([], OpamVariable.of_string "os", None), `Neq, FString "win32")
5353
let sandbox_filter = FOr (linux_filter, macos_filter)
5454

55-
let gpatch_filter =
56-
FOr (FOr (openbsd_filter, netbsd_filter),
57-
FOr (freebsd_filter, FOr (dragonflybsd_filter, macos_filter)))
58-
let patch_filter = FNot gpatch_filter
59-
6055
let gtar_filter = openbsd_filter
6156
let tar_filter = FNot gtar_filter
6257

@@ -131,9 +126,6 @@ let recommended_tools () =
131126
let required_tools ~sandboxing () =
132127
req_dl_tools () @
133128
[
134-
["diff"], None, None;
135-
["patch"], None, Some patch_filter;
136-
["gpatch"], None, Some gpatch_filter;
137129
["tar"], None, Some tar_filter;
138130
["gtar"], None, Some gtar_filter;
139131
["unzip"], None, None;
@@ -146,9 +138,7 @@ let required_tools ~sandboxing () =
146138

147139
let required_packages_for_cygwin =
148140
[
149-
"diffutils";
150141
"make";
151-
"patch";
152142
"tar";
153143
"unzip";
154144
"rsync";

src/core/dune

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,7 @@
33
(public_name opam-core)
44
(synopsis "OCaml Package Manager core internal stdlib")
55
; TODO: Remove (re_export ...) when CI uses the OCaml version that includes https://github.com/ocaml/ocaml/pull/11989
6-
(libraries re (re_export ocamlgraph) unix sha jsonm swhid_core uutf)
6+
(libraries re (re_export ocamlgraph) unix sha jsonm swhid_core uutf patch)
77
(flags (:standard
88
(:include ../ocaml-flags-standard.sexp)
99
(:include ../ocaml-flags-configure.sexp)

src/core/opamFilename.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -445,8 +445,8 @@ let link ?(relative=false) ~target ~link =
445445
OpamSystem.link target (to_string link)
446446
[@@ocaml.warning "-16"]
447447

448-
let patch ?preprocess filename dirname =
449-
OpamSystem.patch ?preprocess ~dir:(Dir.to_string dirname) (to_string filename)
448+
let patch ?preprocess ~allow_unclean filename dirname =
449+
OpamSystem.patch ?preprocess ~allow_unclean ~dir:(Dir.to_string dirname) (to_string filename)
450450

451451
let flock flag ?dontblock file = OpamSystem.flock flag ?dontblock (to_string file)
452452

src/core/opamFilename.mli

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -272,7 +272,7 @@ val remove_suffix: Base.t -> t -> string
272272

273273
(** Apply a patch in a directory. If [preprocess] is set to false, there is no
274274
CRLF translation. Returns [None] on success, the process error otherwise *)
275-
val patch: ?preprocess:bool -> t -> Dir.t -> exn option OpamProcess.job
275+
val patch: ?preprocess:bool -> allow_unclean:bool -> t -> Dir.t -> exn option OpamProcess.job
276276

277277
(** Create an empty file *)
278278
val touch: t -> unit

src/core/opamSystem.ml

Lines changed: 64 additions & 37 deletions
Original file line numberDiff line numberDiff line change
@@ -1588,41 +1588,67 @@ let translate_patch ~dir orig corrected =
15881588
end;
15891589
close_in ch
15901590
1591-
let gpatch = lazy begin
1592-
let rec search_gpatch = function
1593-
| [] -> None
1594-
| patch_cmd::patch_cmds ->
1595-
match OpamProcess.run (make_command ~name:"patch" patch_cmd ["--version"]) with
1596-
| r ->
1597-
(match OpamProcess.is_success r, r.OpamProcess.r_stdout with
1598-
| true, full::_ when
1599-
OpamStd.String.is_prefix_of ~from:0 ~full "GNU patch " ->
1600-
Some patch_cmd
1601-
| _ ->
1602-
search_gpatch patch_cmds)
1603-
| exception _ -> search_gpatch patch_cmds
1591+
exception Internal_patch_error of string
1592+
1593+
let internal_patch ~allow_unclean ~patch_filename ~dir diffs =
1594+
let fmt = Printf.sprintf in
1595+
(* NOTE: It is important to keep this `concat dir ""` to ensure the
1596+
is_prefix_of below doesn't match another similarily named directory *)
1597+
let dir = Filename.concat (real_path dir) "" in
1598+
let get_path file =
1599+
let file = real_path (Filename.concat dir file) in
1600+
if not (OpamStd.String.is_prefix_of ~from:0 ~full:file dir) then
1601+
raise (Internal_patch_error (fmt "Patch %S tried to escape its scope."
1602+
patch_filename));
1603+
file
16041604
in
1605-
let default_cmd, other_cmds =
1606-
match OpamStd.Sys.os () with
1607-
| Darwin
1608-
| DragonFly
1609-
| FreeBSD
1610-
| NetBSD
1611-
| OpenBSD -> ("gpatch", ["patch"])
1612-
| Cygwin
1613-
| Linux
1614-
| Unix
1615-
| Win32
1616-
| Other _ -> ("patch", ["gpatch"])
1605+
let patch ~file content diff =
1606+
match Patch.patch ~cleanly:true content diff with
1607+
| Some x -> x
1608+
| None -> assert false
1609+
| exception _ when not allow_unclean ->
1610+
raise (Internal_patch_error (fmt "Patch %S does not apply cleanly."
1611+
patch_filename))
1612+
| exception _ ->
1613+
match Patch.patch ~cleanly:false content diff with
1614+
| Some x ->
1615+
OpamStd.Option.iter (write (file^".orig")) content;
1616+
x
1617+
| None -> assert false
1618+
| exception _ ->
1619+
OpamStd.Option.iter (write (file^".orig")) content;
1620+
write (file^".rej") (Format.asprintf "%a" Patch.pp diff);
1621+
raise (Internal_patch_error (fmt "Patch %S does not apply cleanly."
1622+
patch_filename))
16171623
in
1618-
match search_gpatch (default_cmd :: other_cmds) with
1619-
| Some gpatch -> gpatch
1620-
| None ->
1621-
OpamConsole.warning "Invalid patch utility. Please install GNU patch";
1622-
default_cmd
1623-
end
1624+
let apply diff = match diff.Patch.operation with
1625+
| Patch.Edit (file1, file2) ->
1626+
(* That seems to be the GNU patch behaviour *)
1627+
let file =
1628+
let file1 = get_path file1 in
1629+
if Sys.file_exists file1 then
1630+
file1
1631+
else
1632+
get_path file2
1633+
in
1634+
let content = read file in
1635+
let content = patch ~file:file (Some content) diff in
1636+
write file content;
1637+
| Patch.Delete file ->
1638+
let file = get_path file in
1639+
Unix.unlink file
1640+
| Patch.Create file ->
1641+
let file = get_path file in
1642+
let content = patch ~file None diff in
1643+
write file content
1644+
| Patch.Rename_only (src, dst) ->
1645+
let src = get_path src in
1646+
let dst = get_path dst in
1647+
Unix.rename src dst
1648+
in
1649+
List.iter apply diffs
16241650
1625-
let patch ?(preprocess=true) ~dir p =
1651+
let patch ?(preprocess=true) ~allow_unclean ~dir p =
16261652
if not (Sys.file_exists p) then
16271653
(OpamConsole.error "Patch file %S not found." p;
16281654
raise Not_found);
@@ -1634,11 +1660,12 @@ let patch ?(preprocess=true) ~dir p =
16341660
else
16351661
p
16361662
in
1637-
let patch_cmd = Lazy.force gpatch in
1638-
make_command ~name:"patch" ~dir patch_cmd ["-p1"; "-i"; p'] @@> fun r ->
1639-
if not (OpamConsole.debug ()) then Sys.remove p';
1640-
if OpamProcess.is_success r then Done None
1641-
else Done (Some (Process_error r))
1663+
let content = read p' in
1664+
try
1665+
let diffs = Patch.parse ~p:1 content in
1666+
internal_patch ~allow_unclean ~patch_filename:p ~dir diffs;
1667+
Done None
1668+
with exn -> Done (Some exn)
16421669
16431670
let register_printer () =
16441671
Printexc.register_printer (function

src/core/opamSystem.mli

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -125,6 +125,9 @@ val read: string -> string
125125
advisory write lock to prevent concurrent reads or writes) *)
126126
val write: string -> string -> unit
127127

128+
(** [get_files dir] returns the list of files inside the directory [dir]. *)
129+
val get_files : string -> string list
130+
128131
(** [remove filename] removes [filename]. Works whether [filename] is
129132
a file or a directory *)
130133
val remove: string -> unit
@@ -328,7 +331,7 @@ val get_lock_fd: lock -> Unix.file_descr
328331
(** Apply a patch file in the current directory. If [preprocess] is set to
329332
false, there is no CRLF translation. Returns the error if the patch didn't
330333
apply. *)
331-
val patch: ?preprocess:bool -> dir:string -> string -> exn option OpamProcess.job
334+
val patch: ?preprocess:bool -> allow_unclean:bool -> dir:string -> string -> exn option OpamProcess.job
332335

333336
(** Returns the end-of-line encoding style for the given file. [None] means that
334337
either the encoding of line endings is mixed, or the file contains no line

src/repository/dune

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,7 @@
33
(public_name opam-repository)
44
(synopsis "OCaml Package Manager remote repository handling library")
55
; TODO: Remove (re_export ...) when CI uses the OCaml version that includes https://github.com/ocaml/ocaml/pull/11989
6-
(libraries (re_export opam-format))
6+
(libraries (re_export opam-format) patch)
77
(flags (:standard
88
(:include ../ocaml-flags-standard.sexp)
99
(:include ../ocaml-flags-configure.sexp)

src/repository/opamRepository.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -538,7 +538,7 @@ let apply_repo_update repo repo_root = function
538538
| `http | `rsync -> false
539539
| _ -> true
540540
in
541-
(OpamFilename.patch ~preprocess f repo_root @@+ function
541+
(OpamFilename.patch ~preprocess ~allow_unclean:false f repo_root @@+ function
542542
| Some e ->
543543
if not (OpamConsole.debug ()) then OpamFilename.remove f;
544544
raise e

0 commit comments

Comments
 (0)