summaryrefslogtreecommitdiff
path: root/build-aux
diff options
context:
space:
mode:
Diffstat (limited to 'build-aux')
-rw-r--r--build-aux/build-self.scm124
-rw-r--r--build-aux/compile-as-derivation.scm21
-rw-r--r--build-aux/hydra/gnu-system.scm34
-rw-r--r--build-aux/run-system-tests.scm49
-rw-r--r--build-aux/update-NEWS.scm9
5 files changed, 185 insertions, 52 deletions
diff --git a/build-aux/build-self.scm b/build-aux/build-self.scm
index 3ecdc931a5..5b281c3bc9 100644
--- a/build-aux/build-self.scm
+++ b/build-aux/build-self.scm
@@ -22,8 +22,11 @@
#:use-module (guix ui)
#:use-module (guix config)
#:use-module (guix modules)
+ #:use-module (guix build-system gnu)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-19)
+ #:use-module (srfi srfi-34)
+ #:use-module (srfi srfi-35)
#:use-module (rnrs io ports)
#:use-module (ice-9 match)
#:use-module (ice-9 popen)
@@ -72,7 +75,7 @@
(variables rest ...))))))
(variables %localstatedir %storedir %sysconfdir %system)))
-(define* (make-config.scm #:key libgcrypt zlib gzip xz bzip2
+(define* (make-config.scm #:key zlib gzip xz bzip2
(package-name "GNU Guix")
(package-version "0")
(bug-report-address "bug-guix@gnu.org")
@@ -92,7 +95,6 @@
%state-directory
%store-database-directory
%config-directory
- %libgcrypt
%libz
%gzip
%bzip2
@@ -137,9 +139,6 @@
(define %xz
#+(and xz (file-append xz "/bin/xz")))
- (define %libgcrypt
- #+(and libgcrypt
- (file-append libgcrypt "/lib/libgcrypt")))
(define %libz
#+(and zlib
(file-append zlib "/lib/libz")))))))
@@ -200,6 +199,54 @@ person's version identifier."
;; XXX: Replace with a Git commit id.
(date->string (current-date 0) "~Y~m~d.~H"))
+(define guile-gcrypt
+ ;; The host Guix may or may not have 'guile-gcrypt', which was introduced in
+ ;; August 2018. If it has it, it's at least version 0.1.0, which is good
+ ;; enough. If it doesn't, specify our own package because the target Guix
+ ;; requires it.
+ (match (find-best-packages-by-name "guile-gcrypt" #f)
+ (()
+ (package
+ (name "guile-gcrypt")
+ (version "0.1.0")
+ (home-page "https://notabug.org/cwebber/guile-gcrypt")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append home-page "/archive/v" version ".tar.gz"))
+ (sha256
+ (base32
+ "1gir7ifknbmbvjlql5j6wzk7bkb5lnmq80q59ngz43hhpclrk5k3"))
+ (file-name (string-append name "-" version ".tar.gz"))))
+ (build-system gnu-build-system)
+ (arguments
+ ;; The 'bootstrap' phase appeared in 'core-updates', which was merged
+ ;; into 'master' ca. June 2018.
+ '(#:phases (modify-phases %standard-phases
+ (delete 'bootstrap)
+ (add-before 'configure 'bootstrap
+ (lambda _
+ (unless (zero? (system* "autoreconf" "-vfi"))
+ (error "autoreconf failed"))
+ #t)))))
+ (native-inputs
+ `(("pkg-config" ,(specification->package "pkg-config"))
+ ("autoconf" ,(specification->package "autoconf"))
+ ("automake" ,(specification->package "automake"))
+ ("texinfo" ,(specification->package "texinfo"))))
+ (inputs
+ `(("guile" ,(specification->package "guile"))
+ ("libgcrypt" ,(specification->package "libgcrypt"))))
+ (synopsis "Cryptography library for Guile using Libgcrypt")
+ (description
+ "Guile-Gcrypt provides a Guile 2.x interface to a subset of the
+GNU Libgcrypt crytographic library. It provides modules for cryptographic
+hash functions, message authentication codes (MAC), public-key cryptography,
+strong randomness, and more. It is implemented using the foreign function
+interface (FFI) of Guile.")
+ (license #f))) ;license:gpl3+
+ ((package . _)
+ package)))
+
(define* (build-program source version
#:optional (guile-version (effective-version))
#:key (pull-version 0))
@@ -212,10 +259,29 @@ person's version identifier."
(('gnu _ ...) #t)
(_ #f)))
+ (define fake-gcrypt-hash
+ ;; Fake (gcrypt hash) module; see below.
+ (scheme-file "hash.scm"
+ #~(define-module (gcrypt hash)
+ #:export (sha1 sha256))))
+
+ (define fake-git
+ (scheme-file "git.scm" #~(define-module (git))))
+
(with-imported-modules `(((guix config)
- => ,(make-config.scm
- #:libgcrypt
- (specification->package "libgcrypt")))
+ => ,(make-config.scm))
+
+ ;; To avoid relying on 'with-extensions', which was
+ ;; introduced in 0.15.0, provide a fake (gcrypt
+ ;; hash) just so that we can build modules, and
+ ;; adjust %LOAD-PATH later on.
+ ((gcrypt hash) => ,fake-gcrypt-hash)
+
+ ;; (guix git-download) depends on (git) but only
+ ;; for peripheral functionality. Provide a dummy
+ ;; (git) to placate it.
+ ((git) => ,fake-git)
+
,@(source-module-closure `((guix store)
(guix self)
(guix derivations)
@@ -237,13 +303,24 @@ person's version identifier."
(match %load-path
((front _ ...)
(unless (string=? front source) ;already done?
- (set! %load-path (list source front)))))))
-
- ;; Only load our own modules or those of Guile.
+ (set! %load-path
+ (list source
+ (string-append #$guile-gcrypt
+ "/share/guile/site/"
+ (effective-version))
+ front)))))))
+
+ ;; Only load Guile-Gcrypt, our own modules, or those
+ ;; of Guile.
(match %load-compiled-path
((front _ ... sys1 sys2)
- (set! %load-compiled-path
- (list 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))))))
(use-modules (guix store)
(guix self)
@@ -297,10 +374,15 @@ person's version identifier."
;; The procedure below is our return value.
(define* (build source
#:key verbose? (version (date-version-string)) system
- (guile-version (match ((@ (guile) version))
- ("2.2.2" "2.2.2")
- (_ (effective-version))))
(pull-version 0)
+
+ ;; For the standalone Guix, default to Guile 2.2. 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"
+ (effective-version)))
+
#:allow-other-keys
#:rest rest)
"Return a derivation that unpacks SOURCE into STORE and compiles Scheme
@@ -345,7 +427,15 @@ files."
;; Unsupported PULL-VERSION.
(return #f))
((? string? str)
- (error "invalid build result" (list build str))))))))
+ (raise (condition
+ (&message
+ (message (format #f "You found a bug: the program '~a'
+failed to compute the derivation for Guix (version: ~s; system: ~s;
+host version: ~s; pull-version: ~s).
+Please report it by email to <~a>.~%"
+ (derivation->output-path build)
+ version system %guix-version pull-version
+ %guix-bug-report-address)))))))))))
;; This file is loaded by 'guix pull'; return it the build procedure.
build
diff --git a/build-aux/compile-as-derivation.scm b/build-aux/compile-as-derivation.scm
index 59a84b1415..d945a8c79c 100644
--- a/build-aux/compile-as-derivation.scm
+++ b/build-aux/compile-as-derivation.scm
@@ -20,13 +20,20 @@
(use-modules (srfi srfi-26))
-;; Add ~/.config/guix/latest to the search path.
-(add-to-load-path
- (and=> (or (getenv "XDG_CONFIG_HOME")
- (and=> (getenv "HOME")
- (cut string-append <> "/.config")))
- (cute string-append <> "/guix/current/share/guile/site/"
- (effective-version))))
+;; Add ~/.config/guix/current to the search path.
+(eval-when (expand load eval)
+ (and=> (or (getenv "XDG_CONFIG_HOME")
+ (and=> (getenv "HOME")
+ (cut string-append <> "/.config/guix/current")))
+ (lambda (current)
+ (set! %load-path
+ (cons (string-append current "/share/guile/site/"
+ (effective-version))
+ %load-path))
+ (set! %load-compiled-path
+ (cons (string-append current "/lib/guile/" (effective-version)
+ "/site-ccache")
+ %load-compiled-path)))))
(use-modules (guix) (guix ui)
(guix git-download)
diff --git a/build-aux/hydra/gnu-system.scm b/build-aux/hydra/gnu-system.scm
index b1554ced4c..d6b0132807 100644
--- a/build-aux/hydra/gnu-system.scm
+++ b/build-aux/hydra/gnu-system.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -56,6 +57,7 @@
(guix packages)
(guix derivations)
(guix monads)
+ (guix ui)
((guix licenses) #:select (gpl3+))
((guix utils) #:select (%current-system))
((guix scripts system) #:select (read-operating-system))
@@ -311,6 +313,29 @@ valid."
packages)))
#:select? (const #t))) ;include hidden packages
+(define (arguments->manifests arguments)
+ "Return the list of manifests extracted from ARGUMENTS."
+ (map (match-lambda
+ ((input-name . relative-path)
+ (let* ((checkout (assq-ref arguments (string->symbol input-name)))
+ (base (assq-ref checkout 'file-name)))
+ (in-vicinity base relative-path))))
+ (assq-ref arguments 'manifests)))
+
+(define (manifests->packages store manifests)
+ "Return the list of packages found in MANIFESTS."
+ (define (load-manifest manifest)
+ (save-module-excursion
+ (lambda ()
+ (set-current-module (make-user-module '((guix profiles) (gnu))))
+ (primitive-load manifest))))
+
+ (delete-duplicates!
+ (map manifest-entry-item
+ (append-map (compose manifest-entries
+ load-manifest)
+ manifests))))
+
;;;
;;; Hydra entry point.
@@ -323,6 +348,7 @@ valid."
("core" 'core) ; only build core packages
("hello" 'hello) ; only build hello
(((? string?) (? string?) ...) 'list) ; only build selected list of packages
+ ("manifests" 'manifests) ; only build packages in the list of manifests
(_ 'all))) ; build everything
(define systems
@@ -419,6 +445,14 @@ valid."
package system))
packages))
'()))
+ ((manifests)
+ ;; Build packages in the list of manifests.
+ (let* ((manifests (arguments->manifests arguments))
+ (packages (manifests->packages store manifests)))
+ (map (lambda (package)
+ (package-job store (job-name package)
+ package system))
+ packages)))
(else
(error "unknown subset" subset))))
systems)))
diff --git a/build-aux/run-system-tests.scm b/build-aux/run-system-tests.scm
index 8b44f579a2..953ba3e221 100644
--- a/build-aux/run-system-tests.scm
+++ b/build-aux/run-system-tests.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2018 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -19,6 +19,7 @@
(define-module (run-system-tests)
#:use-module (gnu tests)
#:use-module (guix store)
+ #:use-module (guix status)
#:use-module (guix monads)
#:use-module (guix derivations)
#:use-module (guix ui)
@@ -63,25 +64,27 @@
(length tests))
(with-store store
- (run-with-store store
- (mlet* %store-monad ((drv (mapm %store-monad system-test-value tests))
- (out -> (map derivation->output-path drv)))
- (mbegin %store-monad
- (show-what-to-build* drv)
- (set-build-options* #:keep-going? #t #:keep-failed? #t
- #:print-build-trace #t
- #:fallback? #t)
- (built-derivations* drv)
- (mlet %store-monad ((valid (filterm (store-lift valid-path?)
- out))
- (failed (filterm (store-lift
- (negate valid-path?))
- out)))
- (format #t "TOTAL: ~a\n" (length drv))
- (for-each (lambda (item)
- (format #t "PASS: ~a~%" item))
- valid)
- (for-each (lambda (item)
- (format #t "FAIL: ~a~%" item))
- failed)
- (exit (null? failed))))))))
+ (with-status-report print-build-event
+ (run-with-store store
+ (mlet* %store-monad ((drv (mapm %store-monad system-test-value tests))
+ (out -> (map derivation->output-path drv)))
+ (mbegin %store-monad
+ (show-what-to-build* drv)
+ (set-build-options* #:keep-going? #t #:keep-failed? #t
+ #:print-build-trace #t
+ #:print-extended-build-trace? #t
+ #:fallback? #t)
+ (built-derivations* drv)
+ (mlet %store-monad ((valid (filterm (store-lift valid-path?)
+ out))
+ (failed (filterm (store-lift
+ (negate valid-path?))
+ out)))
+ (format #t "TOTAL: ~a\n" (length drv))
+ (for-each (lambda (item)
+ (format #t "PASS: ~a~%" item))
+ valid)
+ (for-each (lambda (item)
+ (format #t "FAIL: ~a~%" item))
+ failed)
+ (exit (null? failed)))))))))
diff --git a/build-aux/update-NEWS.scm b/build-aux/update-NEWS.scm
index 2e8f68c9a8..a9dffef1d2 100644
--- a/build-aux/update-NEWS.scm
+++ b/build-aux/update-NEWS.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -128,11 +128,10 @@ paragraph."
(define (main . args)
(match args
((news-file data-directory)
- ;; Don't browse things listed in the user's $GUIX_PACKAGE_PATH. Here we
- ;; assume that the last item in (%package-module-path) is the distro
- ;; directory.
+ ;; Don't browse things listed in the user's $GUIX_PACKAGE_PATH and
+ ;; in external channels.
(parameterize ((%package-module-path
- (list (last (%package-module-path)))))
+ %default-package-module-path))
(define (package-file version)
(string-append data-directory "/packages-"
version ".txt"))
generated by cgit v1.2.3 (git 2.25.4) at 2024-11-05 19:33:10 +0000