1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2014, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
4 ;;; This file is part of GNU Guix.
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.
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.
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/>.
19 (define-module (build-self)
22 #:use-module (guix ui)
23 #:use-module (guix config)
24 #:use-module (guix modules)
25 #:use-module (guix build-system gnu)
26 #:use-module (srfi srfi-1)
27 #:use-module (srfi srfi-19)
28 #:use-module (rnrs io ports)
29 #:use-module (ice-9 match)
30 #:use-module (ice-9 popen)
35 ;;; When loaded, this module returns a monadic procedure of at least one
36 ;;; argument: the source tree to build. It returns a derivation that
39 ;;; This file uses modules provided by the already-installed Guix. Those
40 ;;; modules may be arbitrarily old compared to the version we want to
41 ;;; build. Because of that, it must rely on the smallest set of features
42 ;;; that are likely to be provided by the (guix) and (gnu) modules, and by
43 ;;; Guile itself, forever and ever.
49 ;;; Generating (guix config).
51 ;;; This is copied from (guix self) because we cannot assume (guix self) is
52 ;;; available at this point.
55 (define %dependency-variables
56 ;; (guix config) variables corresponding to dependencies.
57 '(%libgcrypt %libz %xz %gzip %bzip2))
59 (define %persona-variables
60 ;; (guix config) variables that define Guix's persona.
63 %guix-bug-report-address
66 (define %config-variables
67 ;; (guix config) variables corresponding to Guix configuration.
68 (letrec-syntax ((variables (syntax-rules ()
71 ((_ variable rest ...)
72 (cons `(variable . ,variable)
73 (variables rest ...))))))
74 (variables %localstatedir %storedir %sysconfdir %system)))
76 (define* (make-config.scm #:key zlib gzip xz bzip2
77 (package-name "GNU Guix")
79 (bug-report-address "bug-guix@gnu.org")
80 (home-page-url "https://gnu.org/s/guix"))
82 ;; Hack so that Geiser is not confused.
83 (define defmod 'define-module)
85 (scheme-file "config.scm"
87 (#$defmod (guix config)
88 #:export (%guix-package-name
90 %guix-bug-report-address
94 %store-database-directory
101 ;; XXX: Work around <http://bugs.gnu.org/15602>.
102 (eval-when (expand load eval)
103 #$@(map (match-lambda
105 #~(define-public #$name #$value)))
108 (define %store-directory
109 (or (and=> (getenv "NIX_STORE_DIR") canonicalize-path)
112 (define %state-directory
113 ;; This must match `NIX_STATE_DIR' as defined in
115 (or (getenv "NIX_STATE_DIR")
116 (string-append %localstatedir "/guix")))
118 (define %store-database-directory
119 (or (getenv "NIX_DB_DIR")
120 (string-append %state-directory "/db")))
122 (define %config-directory
123 ;; This must match `GUIX_CONFIGURATION_DIRECTORY' as
124 ;; defined in `nix/local.mk'.
125 (or (getenv "GUIX_CONFIGURATION_DIRECTORY")
126 (string-append %sysconfdir "/guix")))
128 (define %guix-package-name #$package-name)
129 (define %guix-version #$package-version)
130 (define %guix-bug-report-address #$bug-report-address)
131 (define %guix-home-page-url #$home-page-url)
134 #+(and gzip (file-append gzip "/bin/gzip")))
136 #+(and bzip2 (file-append bzip2 "/bin/bzip2")))
138 #+(and xz (file-append xz "/bin/xz")))
142 (file-append zlib "/lib/libz")))))))
148 ;;; This is our own variant of 'gexp->script' with an extra #:module-path
149 ;;; parameter, which was unavailable in (guix gexp) until commit
150 ;;; 1ae16033f34cebe802023922436883867010850f (March 2018.)
153 (define (load-path-expression modules path)
154 "Return as a monadic value a gexp that sets '%load-path' and
155 '%load-compiled-path' to point to MODULES, a list of module names. MODULES
156 are searched for in PATH."
157 (mlet %store-monad ((modules (imported-modules modules
159 (compiled (compiled-modules modules
160 #:module-path path)))
161 (return (gexp (eval-when (expand load eval)
163 (cons (ungexp modules) %load-path))
164 (set! %load-compiled-path
165 (cons (ungexp compiled)
166 %load-compiled-path)))))))
168 (define* (gexp->script name exp
169 #:key (guile (default-guile))
170 (module-path %load-path))
171 "Return an executable script NAME that runs EXP using GUILE, with EXP's
172 imported modules in its search path."
173 (mlet %store-monad ((set-load-path
174 (load-path-expression (gexp-modules exp)
176 (gexp->derivation name
178 (call-with-output-file (ungexp output)
180 ;; Note: that makes a long shebang. When the store
181 ;; is /gnu/store, that fits within the 128-byte
182 ;; limit imposed by Linux, but that may go beyond
183 ;; when running tests.
185 "#!~a/bin/guile --no-auto-compile~%!#~%"
188 (write '(ungexp set-load-path) port)
189 (write '(ungexp exp) port)
190 (chmod port #o555))))
191 #:module-path module-path)))
194 (define (date-version-string)
195 "Return the current date and hour in UTC timezone, for use as a poor
196 person's version identifier."
197 ;; XXX: Replace with a Git commit id.
198 (date->string (current-date 0) "~Y~m~d.~H"))
201 ;; The host Guix may or may not have 'guile-gcrypt', which was introduced in
202 ;; August 2018. If it has it, it's at least version 0.1.0, which is good
203 ;; enough. If it doesn't, specify our own package because the target Guix
205 (match (find-best-packages-by-name "guile-gcrypt" #f)
208 (name "guile-gcrypt")
210 (home-page "https://notabug.org/cwebber/guile-gcrypt")
213 (uri (string-append home-page "/archive/v" version ".tar.gz"))
216 "1gir7ifknbmbvjlql5j6wzk7bkb5lnmq80q59ngz43hhpclrk5k3"))
217 (file-name (string-append name "-" version ".tar.gz"))))
218 (build-system gnu-build-system)
220 ;; The 'bootstrap' phase appeared in 'core-updates', which was merged
221 ;; into 'master' ca. June 2018.
222 '(#:phases (modify-phases %standard-phases
224 (add-before 'configure 'bootstrap
226 (unless (zero? (system* "autoreconf" "-vfi"))
227 (error "autoreconf failed"))
230 `(("pkg-config" ,(specification->package "pkg-config"))
231 ("autoconf" ,(specification->package "autoconf"))
232 ("automake" ,(specification->package "automake"))
233 ("texinfo" ,(specification->package "texinfo"))))
235 `(("guile" ,(specification->package "guile"))
236 ("libgcrypt" ,(specification->package "libgcrypt"))))
237 (synopsis "Cryptography library for Guile using Libgcrypt")
239 "Guile-Gcrypt provides a Guile 2.x interface to a subset of the
240 GNU Libgcrypt crytographic library. It provides modules for cryptographic
241 hash functions, message authentication codes (MAC), public-key cryptography,
242 strong randomness, and more. It is implemented using the foreign function
243 interface (FFI) of Guile.")
244 (license #f))) ;license:gpl3+
248 (define* (build-program source version
249 #:optional (guile-version (effective-version))
250 #:key (pull-version 0))
251 "Return a program that computes the derivation to build Guix from SOURCE."
253 ;; Select every module but (guix config) and non-Guix modules.
260 (define fake-gcrypt-hash
261 ;; Fake (gcrypt hash) module; see below.
262 (scheme-file "hash.scm"
263 #~(define-module (gcrypt hash)
264 #:export (sha1 sha256))))
267 (scheme-file "git.scm" #~(define-module (git))))
269 (with-imported-modules `(((guix config)
270 => ,(make-config.scm))
272 ;; To avoid relying on 'with-extensions', which was
273 ;; introduced in 0.15.0, provide a fake (gcrypt
274 ;; hash) just so that we can build modules, and
275 ;; adjust %LOAD-PATH later on.
276 ((gcrypt hash) => ,fake-gcrypt-hash)
278 ;; (guix git-download) depends on (git) but only
279 ;; for peripheral functionality. Provide a dummy
280 ;; (git) to placate it.
283 ,@(source-module-closure `((guix store)
286 (gnu packages bootstrap))
289 (gexp->script "compute-guix-derivation"
291 (use-modules (ice-9 match))
293 (eval-when (expand load eval)
294 ;; Don't augment '%load-path'.
295 (unsetenv "GUIX_PACKAGE_PATH")
297 ;; (gnu packages …) modules are going to be looked up
298 ;; under SOURCE. (guix config) is looked up in FRONT.
299 (match (command-line)
303 (unless (string=? front source) ;already done?
306 (string-append #$guile-gcrypt
311 ;; Only load Guile-Gcrypt, our own modules, or those
313 (match %load-compiled-path
314 ((front _ ... sys1 sys2)
315 (unless (string-prefix? #$guile-gcrypt front)
316 (set! %load-compiled-path
317 (list (string-append #$guile-gcrypt
321 front sys1 sys2))))))
323 (use-modules (guix store)
328 (define (spin system)
330 (circular-list "-" "\\" "|" "/" "-" "\\" "|" "/"))
332 (format (current-error-port)
333 "Computing Guix derivation for '~a'... "
335 (let loop ((spin spin))
336 (display (string-append "\b" (car spin))
337 (current-error-port))
338 (force-output (current-error-port))
342 (match (command-line)
343 ((_ source system version protocol-version)
344 ;; The current input port normally wraps a file
345 ;; descriptor connected to the daemon, or it is
346 ;; connected to /dev/null. In the former case, reuse
347 ;; the connection such that we inherit build options
348 ;; such as substitute URLs and so on; in the latter
349 ;; case, attempt to open a new connection.
350 (let* ((proto (string->number protocol-version))
351 (store (if (integer? proto)
352 (port->connection (duplicate-port
357 (call-with-new-thread
363 (run-with-store store
364 (guix-derivation source version
369 derivation-file-name))))))
370 #:module-path (list source))))
372 ;; The procedure below is our return value.
373 (define* (build source
374 #:key verbose? (version (date-version-string)) system
375 (guile-version (match ((@ (guile) version))
377 (_ (effective-version))))
381 "Return a derivation that unpacks SOURCE into STORE and compiles Scheme
383 ;; Build the build program and then use it as a trampoline to build from
385 (mlet %store-monad ((build (build-program source version guile-version
386 #:pull-version pull-version))
387 (system (if system (return system) (current-system)))
388 (port ((store-lift nix-server-socket)))
389 (major ((store-lift nix-server-major-version)))
390 (minor ((store-lift nix-server-minor-version))))
392 (show-what-to-build* (list build))
393 (built-derivations (list build))
395 ;; Use the port beneath the current store as the stdin of BUILD. This
396 ;; way, we know 'open-pipe*' will not close it on 'exec'. If PORT is
397 ;; not a file port (e.g., it's an SSH channel), then the subprocess's
398 ;; stdin will actually be /dev/null.
399 (let* ((pipe (with-input-from-port port
401 (setenv "GUILE_WARN_DEPRECATED" "no") ;be quiet and drive
402 (open-pipe* OPEN_READ
403 (derivation->output-path build)
404 source system version
405 (if (file-port? port)
407 (logior major minor))
409 (str (get-string-all pipe))
410 (status (close-pipe pipe)))
413 (error "build program failed" (list build status)))
414 ((? derivation-path? drv)
416 (return (newline (current-output-port)))
417 ((store-lift add-temp-root) drv)
418 (return (read-derivation-from-file drv))))
420 ;; Unsupported PULL-VERSION.
423 (error "invalid build result" (list build str))))))))
425 ;; This file is loaded by 'guix pull'; return it the build procedure.
429 ;; eval: (put 'with-load-path 'scheme-indent-function 1)
432 ;;; build-self.scm ends here