;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; available at this point.
;;;
-(define %dependency-variables
- ;; (guix config) variables corresponding to dependencies.
- '(%libgcrypt %libz %xz %gzip %bzip2))
-
(define %persona-variables
;; (guix config) variables that define Guix's persona.
'(%guix-package-name
(variables rest ...))))))
(variables %localstatedir %storedir %sysconfdir %system)))
-(define* (make-config.scm #:key zlib gzip xz bzip2
+(define* (make-config.scm #:key gzip xz bzip2
(package-name "GNU Guix")
(package-version "0")
(bug-report-address "bug-guix@gnu.org")
- (home-page-url "https://gnu.org/s/guix"))
+ (home-page-url "https://guix.gnu.org"))
;; Hack so that Geiser is not confused.
(define defmod 'define-module)
(define %state-directory
;; This must match `NIX_STATE_DIR' as defined in
;; `nix/local.mk'.
- (or (getenv "NIX_STATE_DIR")
+ (or (getenv "GUIX_STATE_DIRECTORY")
(string-append %localstatedir "/guix")))
(define %store-database-directory
- (or (getenv "NIX_DB_DIR")
+ (or (getenv "GUIX_DATABASE_DIRECTORY")
(string-append %state-directory "/db")))
(define %config-directory
(define %bzip2
#+(and bzip2 (file-append bzip2 "/bin/bzip2")))
(define %xz
- #+(and xz (file-append xz "/bin/xz")))
-
- (define %libz
- #+(and zlib
- (file-append zlib "/lib/libz")))))))
+ #+(and xz (file-append xz "/bin/xz")))))))
\f
;;;
#:select? select?))
(gexp->script "compute-guix-derivation"
#~(begin
- (use-modules (ice-9 match))
+ (use-modules (ice-9 match)
+ (ice-9 threads))
(eval-when (expand load eval)
- ;; Don't augment '%load-path'.
- (unsetenv "GUIX_PACKAGE_PATH")
-
;; (gnu packages …) modules are going to be looked up
;; under SOURCE. (guix config) is looked up in FRONT.
(match (command-line)
;; Only load Guile-Gcrypt, our own modules, or those
;; of Guile.
- (match %load-compiled-path
- ((front _ ... sys1 sys2)
- (unless (string-prefix? #$guile-gcrypt front)
- (set! %load-compiled-path
- (list (string-append #$guile-gcrypt
- "/lib/guile/"
- (effective-version)
- "/site-ccache")
- front sys1 sys2))))))
+ (set! %load-compiled-path
+ (cons (string-append #$guile-gcrypt "/lib/guile/"
+ (effective-version)
+ "/site-ccache")
+ %load-compiled-path))
+
+ ;; Disable position recording to save time and space
+ ;; when loading the package modules.
+ (read-disable 'positions))
(use-modules (guix store)
(guix self)
(format (current-error-port)
"Computing Guix derivation for '~a'... "
system)
- (let loop ((spin spin))
- (display (string-append "\b" (car spin))
- (current-error-port))
- (force-output (current-error-port))
- (sleep 1)
- (loop (cdr spin))))
+ (when (isatty? (current-error-port))
+ (let loop ((spin spin))
+ (display (string-append "\b" (car spin))
+ (current-error-port))
+ (force-output (current-error-port))
+ (sleep 1)
+ (loop (cdr spin)))))
(match (command-line)
((_ source system version protocol-version)
derivation-file-name))))))
#:module-path (list source))))
+(define (call-with-clean-environment thunk)
+ (let ((env (environ)))
+ (dynamic-wind
+ (lambda ()
+ (environ '()))
+ thunk
+ (lambda ()
+ (environ env)))))
+
+(define-syntax-rule (with-clean-environment exp ...)
+ "Evaluate EXP in a context where zero environment variables are defined."
+ (call-with-clean-environment (lambda () exp ...)))
+
;; The procedure below is our return value.
(define* (build source
#:key verbose? (version (date-version-string)) system
(pull-version 0)
- ;; For the standalone Guix, default to Guile 2.2. For old
+ ;; For the standalone Guix, default to Guile 3.0. For old
;; versions of 'guix pull' (pre-0.15.0), we have to use the
;; same Guile as the current one.
(guile-version (if (> pull-version 0)
- "2.2"
+ "3.0"
(effective-version)))
#:allow-other-keys
(mlet %store-monad ((build (build-program source version guile-version
#:pull-version pull-version))
(system (if system (return system) (current-system)))
+ (home -> (getenv "HOME"))
+
+ ;; Note: Use the deprecated names here because the
+ ;; caller might be Guix <= 0.16.0.
(port ((store-lift nix-server-socket)))
(major ((store-lift nix-server-major-version)))
(minor ((store-lift nix-server-minor-version))))
(mbegin %store-monad
- (show-what-to-build* (list build))
+ ;; Before 'with-build-handler' was implemented and used, we had to
+ ;; explicitly call 'show-what-to-build*'.
+ (munless (module-defined? (resolve-module '(guix store))
+ 'with-build-handler)
+ (show-what-to-build* (list build)))
(built-derivations (list build))
;; Use the port beneath the current store as the stdin of BUILD. This
;; stdin will actually be /dev/null.
(let* ((pipe (with-input-from-port port
(lambda ()
- (setenv "GUILE_WARN_DEPRECATED" "no") ;be quiet and drive
- (open-pipe* OPEN_READ
- (derivation->output-path build)
- source system version
- (if (file-port? port)
- (number->string
- (logior major minor))
- "none")))))
+ ;; Make sure BUILD is not influenced by
+ ;; $GUILE_LOAD_PATH & co.
+ (with-clean-environment
+ (setenv "GUILE_WARN_DEPRECATED" "no") ;be quiet and drive
+ (setenv "COLUMNS" "120") ;show wider backtraces
+ (when home
+ ;; Inherit HOME so that 'xdg-directory' works.
+ (setenv "HOME" home))
+ (open-pipe* OPEN_READ
+ (derivation->output-path build)
+ source system version
+ (if (file-port? port)
+ (number->string
+ (logior major minor))
+ "none"))))))
(str (get-string-all pipe))
(status (close-pipe pipe)))
(match str
(error "build program failed" (list build status)))
((? derivation-path? drv)
(mbegin %store-monad
- (return (newline (current-output-port)))
+ (return (newline (current-error-port)))
((store-lift add-temp-root) drv)
(return (read-derivation-from-file drv))))
("#f"
HCoop / jackhill / guix / guix.git / blobdiff