Commit | Line | Data |
---|---|---|
20507347 LC |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org> | |
3 | ;;; | |
4 | ;;; This file is part of GNU Guix. | |
5 | ;;; | |
6 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
7 | ;;; under the terms of the GNU General Public License as published by | |
8 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
9 | ;;; your option) any later version. | |
10 | ;;; | |
11 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 | ;;; GNU General Public License for more details. | |
15 | ;;; | |
16 | ;;; You should have received a copy of the GNU General Public License | |
17 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
18 | ||
19 | (define-module (guix quirks) | |
20 | #:use-module ((guix build utils) #:select (substitute*)) | |
21 | #:use-module (srfi srfi-9) | |
22 | #:use-module (ice-9 rdelim) | |
23 | #:export (%quirks | |
24 | ||
25 | patch? | |
26 | applicable-patch? | |
27 | apply-patch | |
28 | ||
29 | %patches)) | |
30 | ||
31 | ;;; Commentary: | |
32 | ;;; | |
33 | ;;; Time traveling is a challenge! Sometimes, going back to the past requires | |
34 | ;;; adjusting the old source code so it can be evaluated with our modern day | |
35 | ;;; Guile and against our modern Guix APIs. This file describes quirks found | |
36 | ;;; in old Guix revisions, along with ways to address them or patch them. | |
37 | ;;; | |
38 | ;;; Code: | |
39 | ||
40 | (define (syscalls-reexports-local-variables? source) | |
41 | "Return true if (guix build syscalls) contains the bug described at | |
42 | <https://bugs.gnu.org/36723>." | |
43 | (catch 'system-error | |
44 | (lambda () | |
45 | (define content | |
46 | (call-with-input-file (string-append source | |
47 | "/guix/build/syscalls.scm") | |
48 | read-string)) | |
49 | ||
50 | ;; The faulty code would use the 're-export' macro, causing the | |
51 | ;; 'AT_SYMLINK_NOFOLLOW' local variable to be re-exported when using | |
52 | ;; Guile > 2.2.4. | |
53 | (string-contains content "(re-export variable)")) | |
54 | (lambda args | |
55 | (if (= ENOENT (system-error-errno args)) | |
56 | #f | |
57 | (apply throw args))))) | |
58 | ||
59 | (define (guile-2.2.4) | |
60 | (module-ref (resolve-interface '(gnu packages guile)) | |
61 | 'guile-2.2.4)) | |
62 | ||
63 | (define %quirks | |
64 | ;; List of predicate/package pairs. This allows us to provide information | |
65 | ;; about specific Guile versions that old Guix revisions might need to use | |
66 | ;; just to be able to build and run the trampoline in %SELF-BUILD-FILE. See | |
67 | ;; <https://bugs.gnu.org/37506> | |
68 | `((,syscalls-reexports-local-variables? . ,guile-2.2.4))) | |
69 | ||
70 | \f | |
71 | ;;; | |
72 | ;;; Patches. | |
73 | ;;; | |
74 | ||
75 | ;; Patch to apply to a source tree. | |
76 | (define-record-type <patch> | |
77 | (patch predicate application) | |
78 | patch? | |
79 | (predicate patch-predicate) ;procedure | |
80 | (application patch-application)) ;procedure | |
81 | ||
82 | (define (applicable-patch? patch source commit) | |
83 | "Return true if PATCH is applicable to SOURCE, a directory, which | |
84 | corresponds to the given Guix COMMIT, a SHA1 hexadecimal string." | |
85 | ;; The predicate is passed COMMIT so that it can choose to only apply to | |
86 | ;; ancestors. | |
87 | ((patch-predicate patch) source commit)) | |
88 | ||
89 | (define (apply-patch patch source) | |
90 | "Apply PATCH onto SOURCE, directly modifying files beneath it." | |
91 | ((patch-application patch) source)) | |
92 | ||
93 | (define %self-build-file | |
94 | ;; The file containing code to build Guix. | |
95 | "build-aux/build-self.scm") | |
96 | ||
97 | (define %bug-41028-patch | |
98 | ;; Patch for <https://bugs.gnu.org/41028>. The faulty code is the | |
99 | ;; 'compute-guix-derivation' body, which uses 'call-with-new-thread' without | |
100 | ;; importing (ice-9 threads). However, the 'call-with-new-thread' binding | |
101 | ;; is no longer available in the default name space on Guile 3.0. | |
102 | (let () | |
103 | (define (missing-ice-9-threads-import? source commit) | |
104 | ;; Return true if %SELF-BUILD-FILE is missing an (ice-9 threads) import. | |
105 | (define content | |
106 | (call-with-input-file (string-append source "/" %self-build-file) | |
107 | read-string)) | |
108 | ||
109 | (and (string-contains content "(call-with-new-thread") | |
110 | (not (string-contains content "(ice-9 threads)")))) | |
111 | ||
112 | (define (add-missing-ice-9-threads-import source) | |
113 | ;; Add (ice-9 threads) import in the gexp of 'compute-guix-derivation'. | |
114 | (substitute* (string-append source "/" %self-build-file) | |
115 | (("^ +\\(use-modules \\(ice-9 match\\)\\)") | |
116 | (object->string '(use-modules (ice-9 match) (ice-9 threads)))))) | |
117 | ||
118 | (patch missing-ice-9-threads-import? add-missing-ice-9-threads-import))) | |
119 | ||
120 | (define %patches | |
121 | ;; Bits of past Guix revisions can become incompatible with newer Guix and | |
122 | ;; Guile. This variable lists <patch> records for the Guix source tree that | |
123 | ;; apply to the Guix source. | |
124 | (list %bug-41028-patch)) |