guix/build/ruby-build-system.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
   3 ;;; Copyright © 2015 Pjotr Prins <pjotr.public01@thebird.nl>
   4 ;;; Copyright © 2015, 2016 Ben Woodcroft <donttrustben@gmail.com>
   5 ;;;
   6 ;;; This file is part of GNU Guix.
   7 ;;;
   8 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   9 ;;; under the terms of the GNU General Public License as published by
  10 ;;; the Free Software Foundation; either version 3 of the License, or (at
  11 ;;; your option) any later version.
  12 ;;;
  13 ;;; GNU Guix is distributed in the hope that it will be useful, but
  14 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;;; GNU General Public License for more details.
  17 ;;;
  18 ;;; You should have received a copy of the GNU General Public License
  19 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 (define-module (guix build ruby-build-system)
  22   #:use-module ((guix build gnu-build-system) #:prefix gnu:)
  23   #:use-module (guix build utils)
  24   #:use-module (ice-9 ftw)
  25   #:use-module (ice-9 match)
  26   #:use-module (ice-9 popen)
  27   #:use-module (ice-9 rdelim)
  28   #:use-module (ice-9 regex)
  29   #:use-module (srfi srfi-1)
  30   #:use-module (srfi srfi-26)
  31   #:export (%standard-phases
  32             ruby-build))
  33
  34 ;; Commentary:
  35 ;;
  36 ;; Builder-side code of the standard Ruby package build procedure.
  37 ;;
  38 ;; Code:
  39
  40 (define (first-matching-file pattern)
  41   "Return the first file name that matches PATTERN in the current working
  42 directory."
  43   (match (find-files "." pattern)
  44     ((file-name . _) file-name)
  45     (() (error "No files matching pattern: " pattern))))
  46
  47 (define gnu:unpack (assq-ref gnu:%standard-phases 'unpack))
  48
  49 (define (gem-archive? file-name)
  50   (string-match "^.*\\.gem$" file-name))
  51
  52 (define* (unpack #:key source #:allow-other-keys)
  53   "Unpack the gem SOURCE and enter the resulting directory."
  54   (if (gem-archive? source)
  55       (begin
  56         (invoke "gem" "unpack" source)
  57         ;; The unpacked gem directory is named the same as the archive,
  58         ;; sans the ".gem" extension.  It is renamed to simply "gem" in an
  59         ;; effort to keep file names shorter to avoid UNIX-domain socket
  60         ;; file names and shebangs that exceed the system's fixed maximum
  61         ;; length when running test suites.
  62         (let ((dir (match:substring (string-match "^(.*)\\.gem$"
  63                                                   (basename source))
  64                                     1)))
  65           (rename-file dir "gem")
  66           (chdir "gem"))
  67         #t)
  68       ;; Use GNU unpack strategy for things that aren't gem archives.
  69       (gnu:unpack #:source source)))
  70
  71 (define (first-gemspec)
  72   (first-matching-file "\\.gemspec$"))
  73
  74 (define* (replace-git-ls-files #:key source #:allow-other-keys)
  75   "Many gemspec files downloaded from outside rubygems.org use `git ls-files`
  76 to list of the files to be included in the built gem.  However, since this
  77 operation is not deterministic, we replace it with `find`."
  78   (when (not (gem-archive? source))
  79     (let ((gemspec (first-gemspec)))
  80       (substitute* gemspec
  81         (("`git ls-files`") "`find . -type f |sort`")
  82         (("`git ls-files -z`") "`find . -type f -print0 |sort -z`"))))
  83   #t)
  84
  85 (define* (extract-gemspec #:key source #:allow-other-keys)
  86   "Remove the original gemspec, if present, and replace it with a new one.
  87 This avoids issues with upstream gemspecs requiring tools such as git to
  88 generate the files list."
  89   (if (gem-archive? source)
  90       (let ((gemspec (or (false-if-exception (first-gemspec))
  91                          ;; Make new gemspec if one wasn't shipped.
  92                          ".gemspec")))
  93
  94         (when (file-exists? gemspec) (delete-file gemspec))
  95
  96         ;; Extract gemspec from source gem.
  97         (let ((pipe (open-pipe* OPEN_READ "gem" "spec" "--ruby" source)))
  98           (dynamic-wind
  99             (const #t)
 100             (lambda ()
 101               (call-with-output-file gemspec
 102                 (lambda (out)
 103                   ;; 'gem spec' writes to stdout, but 'gem build' only reads
 104                   ;; gemspecs from a file, so we redirect the output to a file.
 105                   (while (not (eof-object? (peek-char pipe)))
 106                     (write-char (read-char pipe) out))))
 107               #t)
 108             (lambda ()
 109               (close-pipe pipe)))))
 110       (display "extract-gemspec: skipping as source is not a gem archive\n"))
 111   #t)
 112
 113 (define* (build #:key source #:allow-other-keys)
 114   "Build a new gem using the gemspec from the SOURCE gem."
 115
 116   ;; Build a new gem from the current working directory.  This also allows any
 117   ;; dynamic patching done in previous phases to be present in the installed
 118   ;; gem.
 119   (invoke "gem" "build" (first-gemspec)))
 120
 121 (define* (check #:key tests? test-target #:allow-other-keys)
 122   "Run the gem's test suite rake task TEST-TARGET.  Skip the tests if TESTS?
 123 is #f."
 124   (if tests?
 125       (invoke "rake" test-target)
 126       #t))
 127
 128 (define* (install #:key inputs outputs (gem-flags '())
 129                   #:allow-other-keys)
 130   "Install the gem archive SOURCE to the output store item.  Additional
 131 GEM-FLAGS are passed to the 'gem' invocation, if present."
 132   (let* ((ruby-version
 133           (match:substring (string-match "ruby-(.*)\\.[0-9]$"
 134                                          (assoc-ref inputs "ruby"))
 135                            1))
 136          (out (assoc-ref outputs "out"))
 137          (vendor-dir (string-append out "/lib/ruby/vendor_ruby"))
 138          (gem-file (first-matching-file "\\.gem$"))
 139          (gem-file-basename (basename gem-file))
 140          (gem-name (substring gem-file-basename
 141                               0
 142                               (- (string-length gem-file-basename) 4)))
 143          (gem-dir (string-append vendor-dir "/gems/" gem-name)))
 144     (setenv "GEM_VENDOR" vendor-dir)
 145
 146     (or (zero?
 147           ;; 'zero? system*' allows the custom error handling to function as
 148           ;; expected, while 'invoke' raises its own exception.
 149          (apply system* "gem" "install" gem-file
 150                 "--verbose"
 151                 "--local" "--ignore-dependencies" "--vendor"
 152                 ;; Executables should go into /bin, not
 153                 ;; /lib/ruby/gems.
 154                 "--bindir" (string-append out "/bin")
 155                 gem-flags))
 156         (begin
 157           (let ((failed-output-dir (string-append (getcwd) "/out")))
 158             (mkdir failed-output-dir)
 159             (copy-recursively out failed-output-dir))
 160           (error "installation failed")))
 161
 162     ;; Remove the cached gem file as this is unnecessary and contains
 163     ;; timestamped files rendering builds not reproducible.
 164     (let ((cached-gem (string-append vendor-dir "/cache/" gem-file)))
 165       (log-file-deletion cached-gem)
 166       (delete-file cached-gem))
 167
 168     ;; For gems with native extensions, several Makefile-related files
 169     ;; are created that contain timestamps or other elements making
 170     ;; them not reproducible.  They are unnecessary so we remove them.
 171     (when (file-exists? (string-append gem-dir "/ext"))
 172       (for-each (lambda (file)
 173                   (log-file-deletion file)
 174                   (delete-file file))
 175                 (append
 176                  (find-files (string-append vendor-dir "/doc")
 177                              "page-Makefile.ri")
 178                  (find-files (string-append vendor-dir "/extensions")
 179                              "gem_make.out")
 180                  (find-files (string-append gem-dir "/ext")
 181                              "Makefile"))))
 182
 183     #t))
 184
 185 (define* (wrap-ruby-program prog #:key (gem-clear-paths #t) #:rest vars)
 186   "Make a wrapper for PROG.  VARS should look like this:
 187
 188   '(VARIABLE DELIMITER POSITION LIST-OF-DIRECTORIES)
 189
 190 where DELIMITER is optional.  ':' will be used if DELIMITER is not given.
 191
 192 For example, this command:
 193
 194   (wrap-ruby-program \"foo\"
 195                 '(\"PATH\" \":\" = (\"/gnu/.../bar/bin\"))
 196                 '(\"CERT_PATH\" suffix (\"/gnu/.../baz/certs\"
 197                                         \"/qux/certs\")))
 198
 199 will copy 'foo' to '.real/fool' and create the file 'foo' with the following
 200 contents:
 201
 202   #!location/of/bin/ruby
 203   ENV['PATH'] = \"/gnu/.../bar/bin\"
 204   ENV['CERT_PATH'] = (ENV.key?('CERT_PATH') ? (ENV['CERT_PATH'] + ':') : '') + '/gnu/.../baz/certs:/qux/certs'
 205   load location/of/.real/foo
 206
 207 This is useful for scripts that expect particular programs to be in $PATH, for
 208 programs that expect particular gems to be in the GEM_PATH.
 209
 210 This is preferable to wrap-program, which uses a bash script, as this prevents
 211 ruby scripts from being executed with @command{ruby -S ...}.
 212
 213 If PROG has previously been wrapped by 'wrap-ruby-program', the wrapper is
 214 extended with definitions for VARS."
 215   (define wrapped-file
 216     (string-append (dirname prog) "/.real/" (basename prog)))
 217
 218   (define already-wrapped?
 219     (file-exists? wrapped-file))
 220
 221   (define (last-line port)
 222     ;; Return the last line read from PORT and leave PORT's cursor right
 223     ;; before it.
 224     (let loop ((previous-line-offset 0)
 225                (previous-line "")
 226                (position (seek port 0 SEEK_CUR)))
 227       (match (read-line port 'concat)
 228         ((? eof-object?)
 229          (seek port previous-line-offset SEEK_SET)
 230          previous-line)
 231         ((? string? line)
 232          (loop position line (+ (string-length line) position))))))
 233
 234   (define (export-variable lst)
 235     ;; Return a string that exports an environment variable.
 236     (match lst
 237       ((var sep '= rest)
 238        (format #f "ENV['~a'] = '~a'"
 239                var (string-join rest sep)))
 240       ((var sep 'prefix rest)
 241        (format #f "ENV['~a'] = '~a' + (ENV.key?('~a') ? ('~a' + ENV['~a']) : '')"
 242                var (string-join rest sep) var sep var))
 243       ((var sep 'suffix rest)
 244        (format #f "ENV['~a'] = (ENV.key?('~a') ? (ENV['~a'] + '~a') : '') + '~a'"
 245                var var var sep (string-join rest sep)))
 246       ((var '= rest)
 247        (format #f "ENV['~a'] = '~a'"
 248                var (string-join rest ":")))
 249       ((var 'prefix rest)
 250        (format #f "ENV['~a'] = '~a' + (ENV.key?('~a') ? (':' + ENV['~a']) : '')"
 251                var (string-join rest ":") var var))
 252       ((var 'suffix rest)
 253        (format #f "ENV['~a'] = (ENV.key?('~a') ? (ENV['~a'] + ':') : '') + '~a'"
 254                var var var (string-join rest ":")))))
 255
 256   (if already-wrapped?
 257
 258       ;; PROG is already a wrapper: add the new "export VAR=VALUE" lines just
 259       ;; before the last line.
 260       (let* ((port (open-file prog "r+"))
 261              (last (last-line port)))
 262         (for-each (lambda (var)
 263                     (display (export-variable var) port)
 264                     (newline port))
 265                   vars)
 266         (display last port)
 267         (close-port port))
 268
 269       ;; PROG is not wrapped yet: create a shell script that sets VARS.
 270       (let ((prog-tmp (string-append wrapped-file "-tmp")))
 271         (mkdir-p (dirname prog-tmp))
 272         (link prog wrapped-file)
 273
 274         (call-with-output-file prog-tmp
 275           (lambda (port)
 276             (format port
 277                     "#!~a~%~a~%~a~%load '~a'~%"
 278                     (which "ruby")
 279                     (string-join (map export-variable vars) "\n")
 280                     ;; This ensures that if the GEM_PATH has been changed,
 281                     ;; then that change will be noticed.
 282                     (if gem-clear-paths "Gem.clear_paths" "")
 283                     (canonicalize-path wrapped-file))))
 284
 285         (chmod prog-tmp #o755)
 286         (rename-file prog-tmp prog))))
 287
 288 (define* (wrap #:key inputs outputs #:allow-other-keys)
 289   (define (list-of-files dir)
 290     (map (cut string-append dir "/" <>)
 291          (or (scandir dir (lambda (f)
 292                             (let ((s (stat (string-append dir "/" f))))
 293                               (eq? 'regular (stat:type s)))))
 294              '())))
 295
 296   (define bindirs
 297     (append-map (match-lambda
 298                  ((_ . dir)
 299                   (list (string-append dir "/bin")
 300                         (string-append dir "/sbin"))))
 301                 outputs))
 302
 303   (let* ((out  (assoc-ref outputs "out"))
 304          (var `("GEM_PATH" prefix
 305                 (,(string-append out "/lib/ruby/vendor_ruby")
 306                  ,(getenv "GEM_PATH")))))
 307     (for-each (lambda (dir)
 308                 (let ((files (list-of-files dir)))
 309                   (for-each (cut wrap-ruby-program <> var)
 310                             files)))
 311               bindirs))
 312   #t)
 313
 314 (define (log-file-deletion file)
 315   (display (string-append "deleting '" file "' for reproducibility\n")))
 316
 317 (define %standard-phases
 318   (modify-phases gnu:%standard-phases
 319     (delete 'bootstrap)
 320     (delete 'configure)
 321     (replace 'unpack unpack)
 322     (add-before 'build 'extract-gemspec extract-gemspec)
 323     (add-after 'extract-gemspec 'replace-git-ls-files replace-git-ls-files)
 324     (replace 'build build)
 325     (replace 'check check)
 326     (replace 'install install)
 327     (add-after 'install 'wrap wrap)))
 328
 329 (define* (ruby-build #:key inputs (phases %standard-phases)
 330                      #:allow-other-keys #:rest args)
 331   (apply gnu:gnu-build #:inputs inputs #:phases phases args))