From 3059a35afe3f0ff2561870e0a0fb21e03fc3247a Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 2 Jul 2018 14:47:35 +0200 Subject: utils: Disable memoization for 'location'. This was getting 25% hits, which did not quite justify the overhead. * guix/utils.scm (location): Remove 'mlambda'. --- guix/utils.scm | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) (limited to 'guix') diff --git a/guix/utils.scm b/guix/utils.scm index a5de9605e7..9fbb95d31c 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -773,11 +773,10 @@ be determined." (line location-line) ; 1-indexed line (column location-column)) ; 0-indexed column -(define location - (mlambda (file line column) - "Return the object for the given FILE, LINE, and COLUMN." - (and line column file - (make-location file line column)))) +(define (location file line column) + "Return the object for the given FILE, LINE, and COLUMN." + (and line column file + (make-location file line column))) (define (source-properties->location loc) "Return a location object based on the info in LOC, an alist as returned -- cgit v1.2.3 From 223fa5b327b0892cf45d22e4a9fbfb06164e409d Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 2 Jul 2018 14:49:14 +0200 Subject: utils: Micro-optimize 'source-properties->location'. * guix/utils.scm (source-properties->location): Destructure LOC with 'match', adding a fast path without 'assq-ref' calls. --- guix/utils.scm | 19 +++++++++++++------ 1 file changed, 13 insertions(+), 6 deletions(-) (limited to 'guix') diff --git a/guix/utils.scm b/guix/utils.scm index 9fbb95d31c..f934b6ed13 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -782,12 +782,19 @@ be determined." "Return a location object based on the info in LOC, an alist as returned by Guile's `source-properties', `frame-source', `current-source-location', etc." - (let ((file (assq-ref loc 'filename)) - (line (assq-ref loc 'line)) - (col (assq-ref loc 'column))) - ;; In accordance with the GCS, start line and column numbers at 1. Note - ;; that unlike LINE and `port-column', COL is actually 1-indexed here... - (location file (and line (+ line 1)) col))) + ;; In accordance with the GCS, start line and column numbers at 1. Note + ;; that unlike LINE and `port-column', COL is actually 1-indexed here... + (match loc + ((('line . line) ('column . col) ('filename . file)) ;common case + (and file line col + (make-location file (+ line 1) col))) + (#f + #f) + (_ + (let ((file (assq-ref loc 'filename)) + (line (assq-ref loc 'line)) + (col (assq-ref loc 'column))) + (location file (and line (+ line 1)) col))))) (define (location->source-properties loc) "Return the source property association list based on the info in LOC, -- cgit v1.2.3 From 8970a886e640d584de16b2bc5973c7ef293fa74a Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 2 Jul 2018 14:50:36 +0200 Subject: self: Use #:guile-for-build in the shebang of the 'guix' executable. * guix/self.scm (guix-command): Add #:guile and pass it to 'program-file'. (whole-package): Add #:guile and pass it to 'guix-command'. (compiled-guix): Pass #:guile to 'guix-command' and 'whole-package'. --- guix/self.scm | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) (limited to 'guix') diff --git a/guix/self.scm b/guix/self.scm index 89c5428039..240bb89cd5 100644 --- a/guix/self.scm +++ b/guix/self.scm @@ -343,7 +343,7 @@ DOMAIN, a gettext domain." (define* (guix-command modules #:optional compiled-modules #:key source (dependencies '()) - (guile-version (effective-version))) + guile (guile-version (effective-version))) "Return the 'guix' command such that it adds MODULES and DEPENDENCIES in its load path." (program-file "guix-command" @@ -383,15 +383,17 @@ load path." ;; XXX: It would be more convenient to change it to: ;; (exit (apply guix-main (command-line))) - (apply guix-main (command-line)))))) + (apply guix-main (command-line)))) + #:guile guile)) (define* (whole-package name modules dependencies #:key (guile-version (effective-version)) compiled-modules - info daemon + info daemon guile (command (guix-command modules #:dependencies dependencies + #:guile guile #:guile-version guile-version))) "Return the whole Guix package NAME that uses MODULES, a derivation of all the modules, and DEPENDENCIES, a list of packages depended on. COMMAND is the @@ -630,10 +632,12 @@ assumed to be part of MODULES." (command (guix-command modules compiled #:source source #:dependencies dependencies + #:guile guile-for-build #:guile-version guile-version))) (whole-package name modules dependencies #:compiled-modules compiled #:command command + #:guile guile-for-build ;; Include 'guix-daemon'. XXX: Here we inject an ;; older snapshot of guix-daemon, but that's a good -- cgit v1.2.3 From 084f64cb032b6ab4ce326b088d230bd1ead53ee2 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 2 Jul 2018 14:51:42 +0200 Subject: self: Build with Guile 2.2.4. * guix/self.scm (guile-for-build): In the "2.2" case, choose GUILE-2.2.4. --- guix/self.scm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/self.scm b/guix/self.scm index 240bb89cd5..c9c7138e65 100644 --- a/guix/self.scm +++ b/guix/self.scm @@ -907,8 +907,10 @@ running Guile." (module-ref (resolve-interface '(gnu packages guile)) 'guile-2.2.2)) ("2.2" + ;; Use the latest version, which has fixes for + ;; and VM stack-marking issues. (canonical-package (module-ref (resolve-interface '(gnu packages guile)) - 'guile-2.2/fixed))) + 'guile-2.2.4))) ("2.0" (module-ref (resolve-interface '(gnu packages guile)) 'guile-2.0)))) -- cgit v1.2.3 From 24420f5ffabfbdbe913a5765e5c00e17de18fb4c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 2 Jul 2018 22:15:35 +0200 Subject: packages: Optimize 'package-transitive-supported-systems'. This version is 13% faster than the one above when timing: (fold-packages (lambda (p x) (package-transitive-supported-systems p)) '()) * guix/packages.scm (package-transitive-supported-systems): Make 'systems' a set instead of calling 'lset-intersection' repeatedly. --- guix/packages.scm | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) (limited to 'guix') diff --git a/guix/packages.scm b/guix/packages.scm index c762fa7c39..cd7d3b895c 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -766,15 +766,16 @@ in INPUTS and their transitive propagated inputs." (mlambdaq (package) "Return the intersection of the systems supported by PACKAGE and those supported by its dependencies." - (fold (lambda (input systems) - (match input - ((label (? package? p) . _) - (lset-intersection - string=? systems (package-transitive-supported-systems p))) - (_ - systems))) - (package-supported-systems package) - (bag-direct-inputs (package->bag package))))) + (set->list + (fold (lambda (input systems) + (match input + ((label (? package? p) . _) + (fold set-insert systems + (package-transitive-supported-systems p))) + (_ + systems))) + (list->set (package-supported-systems package)) + (bag-direct-inputs (package->bag package)))))) (define* (supported-package? package #:optional (system (%current-system))) "Return true if PACKAGE is supported on SYSTEM--i.e., if PACKAGE and all its -- cgit v1.2.3 From 0744a9f0029b2f78cc86b193214004b4501fa847 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 2 Jul 2018 23:50:38 +0200 Subject: store: Add 'query-path-info*'. * guix/scripts/size.scm (query-path-info*): Move to... * guix/store.scm (query-path-info*): ... here. --- guix/scripts/size.scm | 11 +---------- guix/store.scm | 10 ++++++++++ 2 files changed, 11 insertions(+), 10 deletions(-) (limited to 'guix') diff --git a/guix/scripts/size.scm b/guix/scripts/size.scm index b7b53e43fb..344be40883 100644 --- a/guix/scripts/size.scm +++ b/guix/scripts/size.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015, 2016, 2017 Ludovic Courtès +;;; Copyright © 2015, 2016, 2017, 2018 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -53,15 +53,6 @@ (define substitutable-path-info* (store-lift substitutable-path-info)) -(define (query-path-info* item) - "Monadic version of 'query-path-info' that returns #f when ITEM is not in -the store." - (lambda (store) - (guard (c ((nix-protocol-error? c) - ;; ITEM is not in the store; return #f. - (values #f store))) - (values (query-path-info store item) store)))) - (define (file-size item) "Return the size in bytes of ITEM, resorting to information from substitutes if ITEM is not in the store." diff --git a/guix/store.scm b/guix/store.scm index 3bf56573bf..bac42f2738 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -107,6 +107,7 @@ references references/substitutes references* + query-path-info* requisites referrers optimize-store @@ -1398,6 +1399,15 @@ where FILE is the entry's absolute file name and STAT is the result of (define references* (store-lift references)) +(define (query-path-info* item) + "Monadic version of 'query-path-info' that returns #f when ITEM is not in +the store." + (lambda (store) + (guard (c ((nix-protocol-error? c) + ;; ITEM is not in the store; return #f. + (values #f store))) + (values (query-path-info store item) store)))) + (define-inlinable (current-system) ;; Consult the %CURRENT-SYSTEM fluid at bind time. This is equivalent to ;; (lift0 %current-system %store-monad), but inlinable, thus avoiding -- cgit v1.2.3 From 8120b23e51d8a21056cf982c6740234b8f858633 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 2 Jul 2018 23:51:20 +0200 Subject: ui: Make 'check-available-space' public. * guix/ui.scm (check-available-space): Add optional 'directory' parameter, defaulting to (%store-prefix). Honor it. Make public. --- guix/ui.scm | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) (limited to 'guix') diff --git a/guix/ui.scm b/guix/ui.scm index 6996b7f1c4..c1101eb4bb 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -87,6 +87,7 @@ leave-on-EPIPE read/eval read/eval-package-expression + check-available-space location->string fill-paragraph %text-width @@ -795,16 +796,17 @@ error." (derivation->output-path derivation out-name))) (derivation-outputs derivation)))) -(define (check-available-space need) - "Make sure at least NEED bytes are available in the store. Otherwise emit a +(define* (check-available-space need + #:optional (directory (%store-prefix))) + "Make sure at least NEED bytes are available in DIRECTORY. Otherwise emit a warning." (let ((free (catch 'system-error (lambda () - (free-disk-space (%store-prefix))) + (free-disk-space directory)) (const #f)))) (when (and free (>= need free)) (warning (G_ "at least ~,1h MB needed but only ~,1h MB available in ~a~%") - (/ need 1e6) (/ free 1e6) (%store-prefix))))) + (/ need 1e6) (/ free 1e6) directory)))) (define* (show-what-to-build store drv #:key dry-run? (use-substitutes? #t) -- cgit v1.2.3 From 71bf6cb700965cfe5b8f3661315017b022d0aca1 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 2 Jul 2018 23:59:52 +0200 Subject: guix system: init: Check the available space before copying. * guix/scripts/system.scm (copy-closure): Call 'query-path-info*' on TO-COPY and REFS. Compute the total size. Call 'check-available-space'. --- guix/scripts/system.scm | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 14aedceac1..92e92237b6 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -148,12 +148,18 @@ REFERENCES as its set of references." "Copy ITEM and all its dependencies to the store under root directory TARGET, and register them." (mlet* %store-monad ((to-copy (topologically-sorted* (list item))) - (refs (mapm %store-monad references* to-copy))) + (refs (mapm %store-monad references* to-copy)) + (info (mapm %store-monad query-path-info* + (delete-duplicates + (append to-copy (concatenate refs))))) + (size -> (reduce + 0 (map path-info-nar-size info)))) (define progress-bar (progress-reporter/bar (length to-copy) (format #f (G_ "copying to '~a'...") target))) + (check-available-space size target) + (call-with-progress-reporter progress-bar (lambda (report) (let ((void (%make-void-port "w"))) -- cgit v1.2.3 From af2f8ae5f14d272d341148764d256792d8ef06aa Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 3 Jul 2018 00:01:20 +0200 Subject: deduplication: Fix incorrect use of 'throw'. * guix/store/deduplication.scm (get-temp-link): In handler, fix call to 'throw'. --- guix/store/deduplication.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/store/deduplication.scm b/guix/store/deduplication.scm index d3139eb904..b1cd8873ae 100644 --- a/guix/store/deduplication.scm +++ b/guix/store/deduplication.scm @@ -88,7 +88,7 @@ LINK-PREFIX." (lambda args (if (= (system-error-errno args) EEXIST) (try (tempname-in link-prefix)) - (throw 'system-error args)))))) + (apply throw args)))))) ;; There are 3 main kinds of errors we can get from hardlinking: "Too many ;; things link to this" (EMLINK), "this link already exists" (EEXIST), and -- cgit v1.2.3 From 3dbf331942f11ee888ccbf849cacdd3a0ab971cd Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 3 Jul 2018 00:26:59 +0200 Subject: deduplication: Place link files under /gnu/store/.links. Previously they'd always be placed next to TO-REPLACE, which would lead to EPERM in some cases. * guix/store/deduplication.scm (replace-with-link): Add #:swap-directory parameter and honor it. Add call to 'make-file-writable'. Catch 'system-error' around 'rename-file'. (deduplicate): Pass #:swap-directory and remove uses of 'false-if-system-error'. * tests/store-deduplication.scm ("deduplicate"): Add 'chmod' call. --- guix/store/deduplication.scm | 28 +++++++++++++++++++--------- tests/store-deduplication.scm | 4 ++++ 2 files changed, 23 insertions(+), 9 deletions(-) (limited to 'guix') diff --git a/guix/store/deduplication.scm b/guix/store/deduplication.scm index b1cd8873ae..b97719d4bf 100644 --- a/guix/store/deduplication.scm +++ b/guix/store/deduplication.scm @@ -94,11 +94,21 @@ LINK-PREFIX." ;; things link to this" (EMLINK), "this link already exists" (EEXIST), and ;; "can't fit more stuff in this directory" (ENOSPC). -(define (replace-with-link target to-replace) - "Atomically replace the file TO-REPLACE with a link to TARGET. Note: TARGET -and TO-REPLACE must be on the same file system." - (let ((temp-link (get-temp-link target (dirname to-replace)))) - (rename-file temp-link to-replace))) +(define* (replace-with-link target to-replace + #:key (swap-directory (dirname target))) + "Atomically replace the file TO-REPLACE with a link to TARGET. Use +SWAP-DIRECTORY as the directory to store temporary hard links. + +Note: TARGET, TO-REPLACE, and SWAP-DIRECTORY must be on the same file system." + (let ((temp-link (get-temp-link target swap-directory))) + (make-file-writable (dirname to-replace)) + (catch 'system-error + (lambda () + (rename-file temp-link to-replace)) + (lambda args + (delete-file temp-link) + (unless (= EMLINK (system-error-errno args)) + (apply throw args)))))) (define-syntax-rule (false-if-system-error (errors ...) exp ...) "Given ERRORS, a list of system error codes to ignore, evaluates EXP... and @@ -131,8 +141,8 @@ under STORE." #:store store)))) (scandir path)) (if (file-exists? link-file) - (false-if-system-error (EMLINK) - (replace-with-link link-file path)) + (replace-with-link link-file path + #:swap-directory links-directory) (catch 'system-error (lambda () (link path link-file)) @@ -141,8 +151,8 @@ under STORE." (cond ((= errno EEXIST) ;; Someone else put an entry for PATH in ;; LINKS-DIRECTORY before we could. Let's use it. - (false-if-system-error (EMLINK) - (replace-with-link path link-file))) + (replace-with-link path link-file + #:swap-directory links-directory)) ((= errno ENOSPC) ;; There's not enough room in the directory index for ;; more entries in .links, but that's fine: we can diff --git a/tests/store-deduplication.scm b/tests/store-deduplication.scm index 2361723199..4ca2ec0f61 100644 --- a/tests/store-deduplication.scm +++ b/tests/store-deduplication.scm @@ -47,6 +47,10 @@ (lambda (port) (put-bytevector port data)))) identical) + ;; Make the parent of IDENTICAL read-only. This should not prevent + ;; deduplication for inserting its hard link. + (chmod (dirname (second identical)) #o544) + (call-with-output-file unique (lambda (port) (put-bytevector port (string->utf8 "This is unique.")))) -- cgit v1.2.3 From ae6fa00af02399e2ffadccc81bd7718cc7c26f10 Mon Sep 17 00:00:00 2001 From: Oleg Pykhalov Date: Sat, 30 Jun 2018 10:51:45 +0300 Subject: import: elpa: Check if 'fetch-elpa-package' rest argument is null. * guix/import/elpa.scm (fetch-elpa-package): Check if 'rest' is null. --- guix/import/elpa.scm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/import/elpa.scm b/guix/import/elpa.scm index 65e0be45ab..c37afaf8e6 100644 --- a/guix/import/elpa.scm +++ b/guix/import/elpa.scm @@ -187,7 +187,9 @@ include VERSION." (url (package-source-url kind name ver repo))) (make-elpa-package name ver (ensure-list reqs) synopsis kind - (package-home-page (first rest)) + (package-home-page (match rest + (() #f) + ((one) one))) (fetch-package-description kind name repo) url))) (_ #f)))) -- cgit v1.2.3 From a5b34d9d24cababcaa9d5e93813ccb3196e11a95 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 3 Jul 2018 10:17:09 +0200 Subject: deduplication: Remove 'false-if-system-error', now unused. * guix/store/deduplication.scm (false-if-system-error): Remove. --- guix/store/deduplication.scm | 11 ----------- 1 file changed, 11 deletions(-) (limited to 'guix') diff --git a/guix/store/deduplication.scm b/guix/store/deduplication.scm index b97719d4bf..6ff4a50de5 100644 --- a/guix/store/deduplication.scm +++ b/guix/store/deduplication.scm @@ -110,17 +110,6 @@ Note: TARGET, TO-REPLACE, and SWAP-DIRECTORY must be on the same file system." (unless (= EMLINK (system-error-errno args)) (apply throw args)))))) -(define-syntax-rule (false-if-system-error (errors ...) exp ...) - "Given ERRORS, a list of system error codes to ignore, evaluates EXP... and -return #f if any of the system error codes in the given list are thrown." - (catch 'system-error - (lambda () - exp ...) - (lambda args - (if (member (system-error-errno args) (list errors ...)) - #f - (apply throw args))))) - (define* (deduplicate path hash #:key (store %store-directory)) "Check if a store item with sha256 hash HASH already exists. If so, replace PATH with a hardlink to the already-existing one. If not, register -- cgit v1.2.3 From 25c7ff6a3ecbaa1e93b38d35c8cbff40b7f4edb8 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 3 Jul 2018 10:52:55 +0200 Subject: syscalls: Define AT_SYMLINK_NOFOLLOW et al. * guix/build/syscalls.scm (AT_FDCWD, AT_SYMLINK_NOFOLLOW, AT_REMOVEDIR) (AT_SYMLINK_FOLLOW, AT_NO_AUTOMOUNT, AT_EMPTY_PATH): New variables. * tests/syscalls.scm ("utime with AT_SYMLINK_NOFOLLOW"): New test. --- guix/build/syscalls.scm | 17 +++++++++++++++++ tests/syscalls.scm | 13 +++++++++++++ 2 files changed, 30 insertions(+) (limited to 'guix') diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 25726b885e..74cb675fcf 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -46,6 +46,14 @@ MNT_DETACH MNT_EXPIRE UMOUNT_NOFOLLOW + + AT_FDCWD + AT_SYMLINK_NOFOLLOW + AT_REMOVEDIR + AT_SYMLINK_FOLLOW + AT_NO_AUTOMOUNT + AT_EMPTY_PATH + restart-on-EINTR mount-points swapon @@ -667,6 +675,15 @@ mounted at FILE." (* (file-system-block-size fs) (file-system-blocks-available fs)))) +;; Flags for the *at command, notably the 'utime' procedure of libguile. +;; From . +(define AT_FDCWD -100) +(define AT_SYMLINK_NOFOLLOW #x100) +(define AT_REMOVEDIR #x200) +(define AT_SYMLINK_FOLLOW #x400) +(define AT_NO_AUTOMOUNT #x800) +(define AT_EMPTY_PATH #x1000) + ;;; ;;; Containers. diff --git a/tests/syscalls.scm b/tests/syscalls.scm index 0d07280b99..3e267c9f01 100644 --- a/tests/syscalls.scm +++ b/tests/syscalls.scm @@ -60,6 +60,19 @@ (any (cute member <> (mount-points)) '("/" "/proc" "/sys" "/dev"))) +(false-if-exception (delete-file temp-file)) +(test-equal "utime with AT_SYMLINK_NOFOLLOW" + '(0 0) + (begin + ;; Test libguile's utime with AT_SYMLINK_NOFOLLOW, which libguile does not + ;; define as of Guile 2.2.4. + (symlink "/nowhere" temp-file) + (utime temp-file 0 0 0 0 AT_SYMLINK_NOFOLLOW) + (let ((st (lstat temp-file))) + (delete-file temp-file) + ;; Note: 'utimensat' does not change 'ctime'. + (list (stat:mtime st) (stat:atime st))))) + (test-assert "swapon, ENOENT/EPERM" (catch 'system-error (lambda () -- cgit v1.2.3 From e5e5119855b0269e8e6507b90c7f4d7df5118fc8 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 3 Jul 2018 11:02:22 +0200 Subject: database: 'reset-timestamps' now correctly handles symlinks. * guix/store/database.scm (reset-timestamps): Use 'utime' with AT_SYMLINK_NOFOLLOW for symlinks. --- guix/store/database.scm | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) (limited to 'guix') diff --git a/guix/store/database.scm b/guix/store/database.scm index 05b2ba6c3f..8f35b63e37 100644 --- a/guix/store/database.scm +++ b/guix/store/database.scm @@ -209,9 +209,7 @@ it's a directory. While at it, canonicalize file permissions." (type type)))))) (scandir* parent)))) ((symlink) - ;; FIXME: Implement bindings for 'futime' to reset the timestamps on - ;; symlinks. - #f) + (utime file 0 0 0 0 AT_SYMLINK_NOFOLLOW)) (else (chmod file (if (executable-file? file) #o555 #o444)) (utime file 0 0 0 0))))) -- cgit v1.2.3 From 90b144d22d001a832a8fb345a7d71e9c657c0c86 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 3 Jul 2018 11:02:54 +0200 Subject: ui: Report file names in 'system-error' exceptions from 'delete-file'. * guix/ui.scm (delete-file): New error-reporting wrapper. --- guix/ui.scm | 3 +++ 1 file changed, 3 insertions(+) (limited to 'guix') diff --git a/guix/ui.scm b/guix/ui.scm index c1101eb4bb..66c9233b44 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -520,6 +520,9 @@ FILE." (set! canonicalize-path (error-reporting-wrapper canonicalize-path (file) file)) +(set! delete-file + (error-reporting-wrapper delete-file (file) file)) + (define (make-regexp* regexp . flags) "Like 'make-regexp' but error out if REGEXP is invalid, reporting the error -- cgit v1.2.3 From f3f1d0a5578b4ad6d85494283eedfaa62b28fe2c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 3 Jul 2018 11:24:32 +0200 Subject: guix system: Make 'init' idempotent again. This fixes a regression introduced in df2f6400b1fbc282ef4d6dd7124ea1c17adc23c2: since the new 'register-path' (actually 'reset-timestamps') would make files read-only, 'delete-file-recursively' would fail to delete them. Thus, re-running 'guix system init' on an already-populated store would fail with a 'delete-file' EPERM. * guix/scripts/system.scm (copy-item): Use 'lstat' instead of 'file-exists?'. Call 'make-file-writable' on each directory below DEST. --- guix/scripts/system.scm | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 92e92237b6..69bd05b516 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -126,7 +126,11 @@ REFERENCES as its set of references." ;; Remove DEST if it exists to make sure that (1) we do not fail badly ;; while trying to overwrite it (see ), and ;; (2) we end up with the right contents. - (when (file-exists? dest) + (when (false-if-exception (lstat dest)) + (for-each make-file-writable + (find-files dest (lambda (file stat) + (eq? 'directory (stat:type stat))) + #:directories? #t)) (delete-file-recursively dest)) (copy-recursively item dest -- cgit v1.2.3 From 86eee976f5ef21fa132de9827ad09a026bfdfd63 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 3 Jul 2018 13:49:28 +0200 Subject: Revert "packages: Optimize 'package-transitive-supported-systems'." This reverts commit 24420f5ffabfbdbe913a5765e5c00e17de18fb4c. This broke 'package-transitive-supported-systems', which would return the union of supported systems instead of the intersection. --- guix/packages.scm | 19 +++++++++---------- 1 file changed, 9 insertions(+), 10 deletions(-) (limited to 'guix') diff --git a/guix/packages.scm b/guix/packages.scm index cd7d3b895c..c762fa7c39 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -766,16 +766,15 @@ in INPUTS and their transitive propagated inputs." (mlambdaq (package) "Return the intersection of the systems supported by PACKAGE and those supported by its dependencies." - (set->list - (fold (lambda (input systems) - (match input - ((label (? package? p) . _) - (fold set-insert systems - (package-transitive-supported-systems p))) - (_ - systems))) - (list->set (package-supported-systems package)) - (bag-direct-inputs (package->bag package)))))) + (fold (lambda (input systems) + (match input + ((label (? package? p) . _) + (lset-intersection + string=? systems (package-transitive-supported-systems p))) + (_ + systems))) + (package-supported-systems package) + (bag-direct-inputs (package->bag package))))) (define* (supported-package? package #:optional (system (%current-system))) "Return true if PACKAGE is supported on SYSTEM--i.e., if PACKAGE and all its -- cgit v1.2.3 From 5b0c648a7c5ac3d827bb6fc61b3b2037a2d4b62c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 4 Jul 2018 10:52:59 +0200 Subject: profiles: 'info-dir-file' hook now produces 'dir.LANG' files. Previously, entries for 'guix.fr.info' would end up in 'dir', above the 'guix.info' entries; consequently, running 'info guix' would actually open 'guix.fr.info', which was confusing for non-French readers. * guix/profiles.scm (info-dir-file)[glibc-utf8-locales]: New variable. [build](info-file-language): New procedure. (install-info): Use it, to create 'dir.LANG' files. Set GUIX_LOCPATH. --- guix/profiles.scm | 30 ++++++++++++++++++++++++++---- 1 file changed, 26 insertions(+), 4 deletions(-) (limited to 'guix') diff --git a/guix/profiles.scm b/guix/profiles.scm index ebd7da2a24..e6b77e8d38 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -703,6 +703,8 @@ MANIFEST." (module-ref (resolve-interface '(gnu packages texinfo)) 'texinfo)) (define gzip ;lazy reference (module-ref (resolve-interface '(gnu packages compression)) 'gzip)) + (define glibc-utf8-locales ;lazy reference + (module-ref (resolve-interface '(gnu packages base)) 'glibc-utf8-locales)) (define build (with-imported-modules '((guix build utils)) @@ -720,11 +722,31 @@ MANIFEST." (map (cut string-append infodir "/" <>) (or (scandir infodir info-file?) '())))) + (define (info-file-language file) + (let* ((base (if (string-suffix? ".gz" file) + (basename file ".info.gz") + (basename file ".info"))) + (dot (string-rindex base #\.))) + (if dot + (string-drop base (+ 1 dot)) + "en"))) + (define (install-info info) - (setenv "PATH" (string-append #+gzip "/bin")) ;for info.gz files - (zero? - (system* (string-append #+texinfo "/bin/install-info") "--silent" - info (string-append #$output "/share/info/dir")))) + (let ((language (info-file-language info))) + ;; We need to choose a valid locale for $LANGUAGE to be honored. + (setenv "LC_ALL" "en_US.utf8") + (setenv "LANGUAGE" language) + (zero? + (system* #+(file-append texinfo "/bin/install-info") + "--silent" info + (apply string-append #$output "/share/info/dir" + (if (string=? "en" language) + '("") + `("." ,language))))))) + + (setenv "PATH" (string-append #+gzip "/bin")) ;for info.gz files + (setenv "GUIX_LOCPATH" + #+(file-append glibc-utf8-locales "/lib/locale")) (mkdir-p (string-append #$output "/share/info")) (exit (every install-info -- cgit v1.2.3 From 5adb2df0a2584d49f1fde7671c81ba54f7e43d51 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 5 Jul 2018 13:35:21 +0200 Subject: pack: Use guile-for-build for the target system. Until now, running "guix pack -s i686-linux" on an x86_64-linux machine, for instance, would use an x86_64 guile for module derivations. This was OK until now, but would break when passing "--localstatedir" due to the introduction of guile-sqlite3: we'd be using the i686 guile-sqlite3 along with the x86_64 guile. * guix/scripts/pack.scm (guix-pack): Pass the 'system option from OPTS to 'package-derivation'. --- guix/scripts/pack.scm | 1 + 1 file changed, 1 insertion(+) (limited to 'guix') diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index 7f087a3a3c..6d5d745bc8 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -722,6 +722,7 @@ Create a bundle of PACKAGE.\n")) (if (assoc-ref opts 'bootstrap?) %bootstrap-guile (canonical-package guile-2.2)) + (assoc-ref opts 'system) #:graft? (assoc-ref opts 'graft?)))) (let* ((dry-run? (assoc-ref opts 'dry-run?)) (relocatable? (assoc-ref opts 'relocatable?)) -- cgit v1.2.3 From 7a369f6d2f3509d39f5f702aa2ced44d8d3636af Mon Sep 17 00:00:00 2001 From: Kyle Meyer Date: Sat, 7 Jul 2018 01:18:21 -0400 Subject: weather: Fix pasto in --version output. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/scripts/weather.scm (%options): Correct the command name passed to show-version-and-exit. Signed-off-by: Ludovic Courtès --- guix/scripts/weather.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/scripts/weather.scm b/guix/scripts/weather.scm index d7c2fbea10..98b7338fb9 100644 --- a/guix/scripts/weather.scm +++ b/guix/scripts/weather.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017, 2018 Ludovic Courtès ;;; Copyright © 2017 Ricardo Wurmus +;;; Copyright © 2018 Kyle Meyer ;;; ;;; This file is part of GNU Guix. ;;; @@ -269,7 +270,7 @@ Report the availability of substitutes.\n")) (exit 0))) (option '(#\V "version") #f #f (lambda args - (show-version-and-exit "guix challenge"))) + (show-version-and-exit "guix weather"))) (option '("substitute-urls") #t #f (lambda (opt name arg result . rest) -- cgit v1.2.3 From 7ede577a5f90a459b731eeb025af450ff891603c Mon Sep 17 00:00:00 2001 From: Kyle Meyer Date: Sat, 7 Jul 2018 00:41:34 -0400 Subject: scripts: Add missing -V option to commands that document it. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/scripts/container.scm (guix-container): * guix/scripts/import.scm (guix-import): * guix/scripts/substitute.scm (guix-substitute): Add -V as the short option for --version to match show-help's description. Signed-off-by: Ludovic Courtès --- guix/scripts/container.scm | 3 ++- guix/scripts/import.scm | 3 ++- guix/scripts/substitute.scm | 3 ++- 3 files changed, 6 insertions(+), 3 deletions(-) (limited to 'guix') diff --git a/guix/scripts/container.scm b/guix/scripts/container.scm index 10aed2be75..8041d64b6b 100644 --- a/guix/scripts/container.scm +++ b/guix/scripts/container.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 David Thompson +;;; Copyright © 2018 Kyle Meyer ;;; ;;; This file is part of GNU Guix. ;;; @@ -54,7 +55,7 @@ Build and manipulate Linux containers.\n")) ((or ("-h") ("--help")) (show-help) (exit 0)) - (("--version") + ((or ("-V") ("--version")) (show-version-and-exit "guix container")) ((action args ...) (if (member action %actions) diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index 67bc7a7553..f8cb85700d 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013, 2014 Ludovic Courtès ;;; Copyright © 2014 David Thompson +;;; Copyright © 2018 Kyle Meyer ;;; ;;; This file is part of GNU Guix. ;;; @@ -104,7 +105,7 @@ Run IMPORTER with ARGS.\n")) ((or ("-h") ("--help")) (show-help) (exit 0)) - (("--version") + ((or ("-V") ("--version")) (show-version-and-exit "guix import")) ((importer args ...) (if (member importer importers) diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index d0beacc8ea..7634bb37f6 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès ;;; Copyright © 2014 Nikita Karetnikov +;;; Copyright © 2018 Kyle Meyer ;;; ;;; This file is part of GNU Guix. ;;; @@ -1108,7 +1109,7 @@ default value." (process-substitution store-path destination #:cache-urls (substitute-urls) #:acl (current-acl)))) - (("--version") + ((or ("-V") ("--version")) (show-version-and-exit "guix substitute")) (("--help") (show-help)) -- cgit v1.2.3 From 85c3fbf5de29bf7c08e445bab9b985a7b84b6406 Mon Sep 17 00:00:00 2001 From: Kyle Meyer Date: Sat, 7 Jul 2018 00:41:35 -0400 Subject: ui: Add -V as short option for --version. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/ui.scm (run-guix): Add -V as the short option for --version for consistency with most commands. Signed-off-by: Ludovic Courtès --- guix/ui.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/ui.scm b/guix/ui.scm index 66c9233b44..6a5feaa953 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -9,6 +9,7 @@ ;;; Copyright © 2015, 2016 Mathieu Lirzin ;;; Copyright © 2016 Roel Janssen ;;; Copyright © 2016 Benz Schenk +;;; Copyright © 2018 Kyle Meyer ;;; ;;; This file is part of GNU Guix. ;;; @@ -1598,7 +1599,7 @@ and signal handling has already been set up." (show-guix-usage)) ((or ("-h") ("--help")) (show-guix-help)) - (("--version") + ((or ("-V") ("--version")) (show-version-and-exit "guix")) (((? option? o) args ...) (format (current-error-port) -- cgit v1.2.3