| 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 match) |
| 23 | #:use-module (ice-9 rdelim) |
| 24 | #:export (%quirks |
| 25 | |
| 26 | patch? |
| 27 | applicable-patch? |
| 28 | apply-patch |
| 29 | |
| 30 | %patches)) |
| 31 | |
| 32 | ;;; Commentary: |
| 33 | ;;; |
| 34 | ;;; Time traveling is a challenge! Sometimes, going back to the past requires |
| 35 | ;;; adjusting the old source code so it can be evaluated with our modern day |
| 36 | ;;; Guile and against our modern Guix APIs. This file describes quirks found |
| 37 | ;;; in old Guix revisions, along with ways to address them or patch them. |
| 38 | ;;; |
| 39 | ;;; Code: |
| 40 | |
| 41 | (define (syscalls-reexports-local-variables? source) |
| 42 | "Return true if (guix build syscalls) contains the bug described at |
| 43 | <https://bugs.gnu.org/36723>." |
| 44 | (catch 'system-error |
| 45 | (lambda () |
| 46 | (define content |
| 47 | (call-with-input-file (string-append source |
| 48 | "/guix/build/syscalls.scm") |
| 49 | read-string)) |
| 50 | |
| 51 | ;; The faulty code would use the 're-export' macro, causing the |
| 52 | ;; 'AT_SYMLINK_NOFOLLOW' local variable to be re-exported when using |
| 53 | ;; Guile > 2.2.4. |
| 54 | (string-contains content "(re-export variable)")) |
| 55 | (lambda args |
| 56 | (if (= ENOENT (system-error-errno args)) |
| 57 | #f |
| 58 | (apply throw args))))) |
| 59 | |
| 60 | (define (requires-guile-2.2? source) |
| 61 | "Return true if SOURCE uses Guile 2.2 for the shebang of |
| 62 | 'compute-guix-derivation'." |
| 63 | (define content |
| 64 | (call-with-input-file (string-append source "/" %self-build-file) |
| 65 | read-string)) |
| 66 | |
| 67 | ;; The 'find-best-packages-by-name' call is inserted by %BUG-41214-PATCH. |
| 68 | (string-contains content |
| 69 | (object->string |
| 70 | '(find-best-packages-by-name "guile" "2.2")))) |
| 71 | |
| 72 | (define (guile-2.2.4) |
| 73 | (module-ref (resolve-interface '(gnu packages guile)) |
| 74 | 'guile-2.2.4)) |
| 75 | |
| 76 | (define %quirks |
| 77 | ;; List of predicate/package pairs. This allows us to provide information |
| 78 | ;; about specific Guile versions that old Guix revisions might need to use |
| 79 | ;; just to be able to build and run the trampoline in %SELF-BUILD-FILE. See |
| 80 | ;; <https://bugs.gnu.org/37506> |
| 81 | `((,syscalls-reexports-local-variables? . ,guile-2.2.4) |
| 82 | (,requires-guile-2.2? . ,guile-2.2.4))) |
| 83 | |
| 84 | \f |
| 85 | ;;; |
| 86 | ;;; Patches. |
| 87 | ;;; |
| 88 | |
| 89 | ;; Patch to apply to a source tree. |
| 90 | (define-record-type <patch> |
| 91 | (patch predicate application) |
| 92 | patch? |
| 93 | (predicate patch-predicate) ;procedure |
| 94 | (application patch-application)) ;procedure |
| 95 | |
| 96 | (define (applicable-patch? patch source commit) |
| 97 | "Return true if PATCH is applicable to SOURCE, a directory, which |
| 98 | corresponds to the given Guix COMMIT, a SHA1 hexadecimal string." |
| 99 | ;; The predicate is passed COMMIT so that it can choose to only apply to |
| 100 | ;; ancestors. |
| 101 | ((patch-predicate patch) source commit)) |
| 102 | |
| 103 | (define (apply-patch patch source) |
| 104 | "Apply PATCH onto SOURCE, directly modifying files beneath it." |
| 105 | ((patch-application patch) source)) |
| 106 | |
| 107 | (define %self-build-file |
| 108 | ;; The file containing code to build Guix. |
| 109 | "build-aux/build-self.scm") |
| 110 | |
| 111 | (define %bug-41028-patch |
| 112 | ;; Patch for <https://bugs.gnu.org/41028>. The faulty code is the |
| 113 | ;; 'compute-guix-derivation' body, which uses 'call-with-new-thread' without |
| 114 | ;; importing (ice-9 threads). However, the 'call-with-new-thread' binding |
| 115 | ;; is no longer available in the default name space on Guile 3.0. |
| 116 | (let () |
| 117 | (define (missing-ice-9-threads-import? source commit) |
| 118 | ;; Return true if %SELF-BUILD-FILE is missing an (ice-9 threads) import. |
| 119 | (define content |
| 120 | (call-with-input-file (string-append source "/" %self-build-file) |
| 121 | read-string)) |
| 122 | |
| 123 | (and (string-contains content "(call-with-new-thread") |
| 124 | (not (string-contains content "(ice-9 threads)")))) |
| 125 | |
| 126 | (define (add-missing-ice-9-threads-import source) |
| 127 | ;; Add (ice-9 threads) import in the gexp of 'compute-guix-derivation'. |
| 128 | (substitute* (string-append source "/" %self-build-file) |
| 129 | (("^ +\\(use-modules \\(ice-9 match\\)\\)") |
| 130 | (object->string '(use-modules (ice-9 match) (ice-9 threads)))))) |
| 131 | |
| 132 | (patch missing-ice-9-threads-import? add-missing-ice-9-threads-import))) |
| 133 | |
| 134 | (define %bug-41214-patch |
| 135 | ;; Patch for <https://bugs.gnu.org/41214>. Around v1.0.0, (guix build |
| 136 | ;; compile) would use Guile 2.2 procedures to access the set of available |
| 137 | ;; compilation options. These procedures no longer exist in 3.0. |
| 138 | (let () |
| 139 | (define (accesses-guile-2.2-optimization-options? source commit) |
| 140 | (catch 'system-error |
| 141 | (lambda () |
| 142 | (call-with-input-file (string-append source |
| 143 | "/guix/build/compile.scm") |
| 144 | (lambda (port) |
| 145 | (match (read port) |
| 146 | (('define-module ('guix 'build 'compile) |
| 147 | _ ... |
| 148 | #:use-module ('language 'tree-il 'optimize) |
| 149 | #:use-module ('language 'cps 'optimize) |
| 150 | #:export ('%default-optimizations |
| 151 | '%lightweight-optimizations |
| 152 | 'compile-files)) |
| 153 | #t) |
| 154 | (_ |
| 155 | ;; Before v1.0.0 (ca. Dec. 2018), the 'use-modules' form |
| 156 | ;; would show up in a subsequent 'cond-expand' clause. |
| 157 | ;; See <https://bugs.gnu.org/42519>. |
| 158 | (match (read port) |
| 159 | (('cond-expand |
| 160 | ('guile-2.2 ('use-modules ('language 'tree-il 'optimize) |
| 161 | _ ...)) |
| 162 | _ ...) |
| 163 | #t) |
| 164 | (_ |
| 165 | #f))))))) |
| 166 | (const #f))) |
| 167 | |
| 168 | (define (build-with-guile-2.2 source) |
| 169 | (substitute* (string-append source "/" %self-build-file) |
| 170 | (("\\(default-guile\\)") |
| 171 | ;; Note: This goes hand in hand with the 'requires-guile-2.2?' quirk. |
| 172 | (object->string '(car (find-best-packages-by-name "guile" "2.2")))) |
| 173 | (("\\(find-best-packages-by-name \"guile-gcrypt\" #f\\)") |
| 174 | (object->string '(find-best-packages-by-name "guile2.2-gcrypt" #f)))) |
| 175 | #t) |
| 176 | |
| 177 | (patch accesses-guile-2.2-optimization-options? |
| 178 | build-with-guile-2.2))) |
| 179 | |
| 180 | (define %patches |
| 181 | ;; Bits of past Guix revisions can become incompatible with newer Guix and |
| 182 | ;; Guile. This variable lists <patch> records for the Guix source tree that |
| 183 | ;; apply to the Guix source. |
| 184 | (list %bug-41028-patch |
| 185 | %bug-41214-patch)) |