guix/quirks.scm

   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))