From 47ebb1a850efe923e4b20080135e6e88087da673 Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Fri, 22 Dec 2017 00:05:12 +0100 Subject: guix: Exclude broken symlinks from man files. * guix/man-db.scm (man-files): Remove broken symlinks from list of man pages. --- guix/man-db.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/man-db.scm b/guix/man-db.scm index 5d62e0c82d..732aef1083 100644 --- a/guix/man-db.scm +++ b/guix/man-db.scm @@ -187,7 +187,8 @@ (define (man-files directory) "Return the list of man pages found under DIRECTORY, recursively." - (find-files directory "\\.[0-9][a-z]?(\\.gz)?$")) + ;; Filter the list to ensure that broken symlinks are excluded. + (filter file-exists? (find-files directory "\\.[0-9][a-z]?(\\.gz)?$"))) (define (mandb-entries directory) "Return mandb entries for the man pages found under DIRECTORY, recursively." -- cgit v1.2.3 From 893d0b0bf320eb20b9dd7c57eefcd2fc1371225d Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 18 Dec 2017 15:05:55 +0100 Subject: guix system: Check mapped devices upon 'init' and 'reconfigure'. * guix/scripts/system.scm (check-mapped-devices): New procedure. (perform-action): Add call to 'check-mapped-devices'. --- guix/scripts/system.scm | 24 +++++++++++++++++++++--- 1 file changed, 21 insertions(+), 3 deletions(-) (limited to 'guix') diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 36aed3331f..ebcf3e4f3b 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -44,6 +44,7 @@ #:use-module (gnu system) #:use-module (gnu bootloader) #:use-module (gnu system file-systems) + #:use-module (gnu system mapped-devices) #:use-module (gnu system linux-container) #:use-module (gnu system uuid) #:use-module (gnu system vm) @@ -621,6 +622,22 @@ any, are available. Raise an error if they're not." ;; Better be safe than sorry. (exit 1)))) +(define (check-mapped-devices mapped-devices) + "Check that each of MAPPED-DEVICES is valid according to the 'check' +procedure of its type." + (for-each (lambda (md) + (let ((check (mapped-device-kind-check + (mapped-device-type md)))) + ;; We expect CHECK to raise an exception with a detailed + ;; '&message' if something goes wrong, but handle the case + ;; where it just returns #f. + (unless (check md) + (leave (G_ "~a: invalid '~a' mapped device~%") + (location->string + (source-properties->location + (mapped-device-location md))))))) + mapped-devices)) + ;;; ;;; Action. @@ -710,9 +727,10 @@ output when building a system derivation, such as a disk image." ;; Check whether the declared file systems exist. This is better than ;; instantiating a broken configuration. Assume that we can only check if ;; running as root. - (when (and (memq action '(init reconfigure)) - (zero? (getuid))) - (check-file-system-availability (operating-system-file-systems os))) + (when (memq action '(init reconfigure)) + (when (zero? (getuid)) + (check-file-system-availability (operating-system-file-systems os))) + (check-mapped-devices (operating-system-mapped-devices os))) (mlet* %store-monad ((sys (system-derivation-for-action os action -- cgit v1.2.3 From 3e30cdf1c35ebeb52630ec19b3b43b9e6d5ffb81 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 22 Dec 2017 23:40:57 +0100 Subject: guix build: Support '--with-source=PACKAGE@VERSION=URI'. * guix/scripts/build.scm (numeric-extension?, tarball-base-name): New procedures, formerly in 'package-with-source'. (transform-package-source)[new-sources]: Look for '=' in URI. Each element of the list of now a (PKG VERSION SOURCE) tuple. Pass VERSION to 'package-with-source'. (package-with-source): Add 'version' parameter and honor it. * tests/scripts-build.scm ("options->transformation, with-source, PKG=URI") ("options->transformation, with-source, PKG@VER=URI"): New tests. * doc/guix.texi (Package Transformation Options): Document the new forms. --- doc/guix.texi | 16 +++++++--- guix/scripts/build.scm | 85 +++++++++++++++++++++++++++++++------------------ tests/scripts-build.scm | 29 +++++++++++++++++ 3 files changed, 94 insertions(+), 36 deletions(-) (limited to 'guix') diff --git a/doc/guix.texi b/doc/guix.texi index 94d4d8f92d..4e83c76be7 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -5430,14 +5430,20 @@ without having to type in the definitions of package variants @table @code @item --with-source=@var{source} -Use @var{source} as the source of the corresponding package. +@itemx --with-source=@var{package}=@var{source} +@itemx --with-source=@var{package}@@@var{version}=@var{source} +Use @var{source} as the source of @var{package}, and @var{version} as +its version number. @var{source} must be a file name or a URL, as for @command{guix download} (@pxref{Invoking guix download}). -The ``corresponding package'' is taken to be the one specified on the -command line the name of which matches the base of @var{source}---e.g., +When @var{package} is omitted, +it is taken to be the package name specified on the +command line that matches the base of @var{source}---e.g., if @var{source} is @code{/src/guile-2.0.10.tar.gz}, the corresponding -package is @code{guile}. Likewise, the version string is inferred from +package is @code{guile}. + +Likewise, when @var{version} is omitted, the version string is inferred from @var{source}; in the previous example, it is @code{2.0.10}. This option allows users to try out versions of packages other than the @@ -5460,7 +5466,7 @@ guix build guile --with-source=../guile-2.0.9.219-e1bb7.tar.xz @example $ git clone git://git.sv.gnu.org/guix.git -$ guix build guix --with-source=./guix +$ guix build guix --with-source=guix@@1.0=./guix @end example @item --with-input=@var{package}=@var{replacement} diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index 0571b874f1..57f2d82c5c 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -25,9 +25,12 @@ #:use-module (guix packages) #:use-module (guix grafts) + #:use-module (guix utils) + ;; Use the procedure that destructures "NAME-VERSION" forms. - #:use-module ((guix utils) #:hide (package-name->name+version)) - #:use-module ((guix build utils) #:select (package-name->name+version)) + #:use-module ((guix build utils) + #:select ((package-name->name+version + . hyphen-package-name->name+version))) #:use-module (guix monads) #:use-module (guix gexp) @@ -127,33 +130,37 @@ found. Return #f if no build log was found." (define register-root* (store-lift register-root)) -(define (package-with-source store p uri) +(define (numeric-extension? file-name) + "Return true if FILE-NAME ends with digits." + (string-every char-set:hex-digit (file-extension file-name))) + +(define (tarball-base-name file-name) + "Return the \"base\" of FILE-NAME, removing '.tar.gz' or similar +extensions." + ;; TODO: Factorize. + (cond ((not (file-extension file-name)) + file-name) + ((numeric-extension? file-name) + file-name) + ((string=? (file-extension file-name) "tar") + (file-sans-extension file-name)) + ((file-extension file-name) + => + (match-lambda + ("scm" file-name) + (else (tarball-base-name (file-sans-extension file-name))))) + (else + file-name))) + +(define* (package-with-source store p uri #:optional version) "Return a package based on P but with its source taken from URI. Extract the new package's version number from URI." - (define (numeric-extension? file-name) - ;; Return true if FILE-NAME ends with digits. - (string-every char-set:hex-digit (file-extension file-name))) - - (define (tarball-base-name file-name) - ;; Return the "base" of FILE-NAME, removing '.tar.gz' or similar - ;; extensions. - ;; TODO: Factorize. - (cond ((not (file-extension file-name)) - file-name) - ((numeric-extension? file-name) - file-name) - ((string=? (file-extension file-name) "tar") - (file-sans-extension file-name)) - ((file-extension file-name) - (tarball-base-name (file-sans-extension file-name))) - (else - file-name))) - (let ((base (tarball-base-name (basename uri)))) - (let-values (((name version) - (package-name->name+version base))) + (let-values (((_ version*) + (hyphen-package-name->name+version base))) (package (inherit p) - (version (or version (package-version p))) + (version (or version version* + (package-version p))) ;; Use #:recursive? #t to allow for directories. (source (download-to-store store uri @@ -173,8 +180,23 @@ the new package's version number from URI." matching URIs given in SOURCES." (define new-sources (map (lambda (uri) - (cons (package-name->name+version (basename uri)) - uri)) + (match (string-index uri #\=) + (#f + ;; Determine the package name and version from URI. + (call-with-values + (lambda () + (hyphen-package-name->name+version + (tarball-base-name (basename uri)))) + (lambda (name version) + (list name version uri)))) + (index + ;; What's before INDEX is a "PKG@VER" or "PKG" spec. + (call-with-values + (lambda () + (package-name->name+version (string-take uri index))) + (lambda (name version) + (list name version + (string-drop uri (+ 1 index)))))))) sources)) (lambda (store obj) @@ -182,10 +204,11 @@ matching URIs given in SOURCES." (result '())) (match obj ((? package? p) - (let ((source (assoc-ref sources (package-name p)))) - (if source - (package-with-source store p source) - p))) + (match (assoc-ref sources (package-name p)) + ((version source) + (package-with-source store p source version)) + (#f + p))) (_ obj))))) diff --git a/tests/scripts-build.scm b/tests/scripts-build.scm index a408ea6f8d..190426ed06 100644 --- a/tests/scripts-build.scm +++ b/tests/scripts-build.scm @@ -96,6 +96,35 @@ (string-contains (get-output-string port) "had no effect")))))) +(test-assert "options->transformation, with-source, PKG=URI" + (let* ((p (dummy-package "foo")) + (s (search-path %load-path "guix.scm")) + (f (string-append "foo=" s)) + (t (options->transformation `((with-source . ,f))))) + (with-store store + (let ((new (t store p))) + (and (not (eq? new p)) + (string=? (package-name new) (package-name p)) + (string=? (package-version new) + (package-version p)) + (string=? (package-source new) + (add-to-store store (basename s) #t + "sha256" s))))))) + +(test-assert "options->transformation, with-source, PKG@VER=URI" + (let* ((p (dummy-package "foo")) + (s (search-path %load-path "guix.scm")) + (f (string-append "foo@42.0=" s)) + (t (options->transformation `((with-source . ,f))))) + (with-store store + (let ((new (t store p))) + (and (not (eq? new p)) + (string=? (package-name new) (package-name p)) + (string=? (package-version new) "42.0") + (string=? (package-source new) + (add-to-store store (basename s) #t + "sha256" s))))))) + (test-assert "options->transformation, with-input" (let* ((p (dummy-package "guix.scm" (inputs `(("foo" ,(specification->package "coreutils")) -- cgit v1.2.3 From 6a1a69679d8ed90b2a6281508d4760c0e9337e78 Mon Sep 17 00:00:00 2001 From: Danny Milosavljevic Date: Sun, 31 Dec 2017 00:29:59 +0100 Subject: build: dub-build-system: Make builds reproducible. * guix/build/dub-build-system.scm (build): Make reproducible. (check): Make reproducible. --- guix/build/dub-build-system.scm | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/build/dub-build-system.scm b/guix/build/dub-build-system.scm index b2cb02e639..432d51f6a7 100644 --- a/guix/build/dub-build-system.scm +++ b/guix/build/dub-build-system.scm @@ -91,11 +91,19 @@ (grep* "sourceLibrary" "dub.sdl") ; note: format is different! (grep* "sourceLibrary" "dub.json")) #t - (zero? (apply system* `("dub" "build" ,@dub-build-flags))))) + (let ((status (zero? (apply system* `("dub" "build" ,@dub-build-flags))))) + (substitute* ".dub/dub.json" + (("\"lastUpgrade\": \"[^\"]*\"") + "\"lastUpgrade\": \"1970-01-01T00:00:00.0000000\"")) + status))) (define* (check #:key tests? #:allow-other-keys) (if tests? - (zero? (system* "dub" "test")) + (let ((status (zero? (system* "dub" "test")))) + (substitute* ".dub/dub.json" + (("\"lastUpgrade\": \"[^\"]*\"") + "\"lastUpgrade\": \"1970-01-01T00:00:00.0000000\"")) + status) #t)) (define* (install #:key inputs outputs #:allow-other-keys) -- cgit v1.2.3