From unknown Sat Aug 09 09:36:38 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#59163] [PATCH v2 4/4] shell: Detect --symlink spec problems early. Resent-From: Maxim Cournoyer Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 10 Nov 2022 04:25:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 59163 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 59163@debbugs.gnu.org Cc: Maxim Cournoyer X-Debbugs-Original-To: guix-patches@gnu.org Received: via spool by submit@debbugs.gnu.org id=B.166805426219421 (code B ref -1); Thu, 10 Nov 2022 04:25:03 +0000 Received: (at submit) by debbugs.gnu.org; 10 Nov 2022 04:24:22 +0000 Received: from localhost ([127.0.0.1]:41558 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1osz6y-000535-Ox for submit@debbugs.gnu.org; Wed, 09 Nov 2022 23:24:21 -0500 Received: from lists.gnu.org ([209.51.188.17]:52112) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1osz6t-00052a-9i for submit@debbugs.gnu.org; Wed, 09 Nov 2022 23:24:17 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1osz6s-00046w-Ic for guix-patches@gnu.org; Wed, 09 Nov 2022 23:24:15 -0500 Received: from mail-qk1-x735.google.com ([2607:f8b0:4864:20::735]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1osz6p-0006mf-Pm for guix-patches@gnu.org; Wed, 09 Nov 2022 23:24:14 -0500 Received: by mail-qk1-x735.google.com with SMTP id v8so486022qkg.12 for ; Wed, 09 Nov 2022 20:24:11 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20210112; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=eor9LWxTKeGMVCJ5LjFJhfGhvz5uVx3IkChxdnJf8Q0=; b=BYMDqrIvUiKHars7qN9wNdAqFvpQKc3yJCN30kPS/E75WP7o7L+OLt3UhfqRmabTSu 6bb9FMHSs/Mk8M3m3wVNqxgGf2xT9XZPLDdP0u4iCubgXjIOvChw9EdcXgkdY5wtrVtZ 5LkirNI3P7Sn60fzruqDLFqYusehVUJR+I6MpG8aoyPbRR+WG1BwOd2pKFt2kJYxJdRi tUUOh2wcDfBNNIQpY3h/J8wTUdPWbK5AcDtiincLyMNovEH5PMM9r1hjGaT15HQpEZaW 6fQLcVKLXPLQcvws+CH0TxTiqzfdptHZeLEZlpoY9oJdtY/uIblPGfG/awgUkBpQctmS P3qw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=eor9LWxTKeGMVCJ5LjFJhfGhvz5uVx3IkChxdnJf8Q0=; b=YnW3gOT24P9gQ1iavBl9D2LzvCu8MRTJf/Wu7DWKVIraK0+iesPtaAM2QAaOx+yiIQ PCtrMCtL/aO2cM6+0T3tMhWadcV4Pl2p0RmwaQecqpu+m01kB7OgznXvedKyCAsaI6tr lwsFRXRBIAg7VmIEb/OOPzljh6Fu8fBuQkZiBtimXE2jh3kgrValhZIdV8yovlCuNquo qJknZ83zm70FsDP4TBFUpeaPyTeYA+iUjS63UpGRiZGAR5rHBcvKqt//n7rxIo35RYEZ zbQlACdLWAE9aYHVNVJ1vmrbnznw3EzkpHGtIuKs0nvVuvgg0bKCx1ntFfkH+c6xpCht kH/Q== X-Gm-Message-State: ACrzQf2Gjyyb34uDk61GeLr1I3csBpv0tdoi+EcSq0cBgVnrhJ4WBzu2 CW2ps+cyB+vRfer+vX5R2oDJE7fO4ZA= X-Google-Smtp-Source: AMsMyM5pp58ovmT7UIGmbamUcVSZ/+ZKRBi0LpDCJfi9W7DaRZF44PvXEbNbQcRwvepYW82wNitPHg== X-Received: by 2002:ae9:dfc5:0:b0:6f9:f70f:b4ab with SMTP id t188-20020ae9dfc5000000b006f9f70fb4abmr46075893qkf.528.1668054250322; Wed, 09 Nov 2022 20:24:10 -0800 (PST) Received: from localhost.localdomain ([2607:fad8:4:3::1001]) by smtp.gmail.com with ESMTPSA id r1-20020ac85e81000000b0039cc7ebf46bsm10515105qtx.93.2022.11.09.20.24.09 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Wed, 09 Nov 2022 20:24:09 -0800 (PST) From: Maxim Cournoyer Date: Wed, 9 Nov 2022 23:23:51 -0500 Message-Id: <20221110042351.829-4-maxim.cournoyer@gmail.com> X-Mailer: git-send-email 2.37.3 In-Reply-To: <20221110042351.829-1-maxim.cournoyer@gmail.com> References: <87h6z7omzy.fsf_-_@gnu.org> <20221110042351.829-1-maxim.cournoyer@gmail.com> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit Received-SPF: pass client-ip=2607:f8b0:4864:20::735; envelope-from=maxim.cournoyer@gmail.com; helo=mail-qk1-x735.google.com X-Spam_score_int: -20 X-Spam_score: -2.1 X-Spam_bar: -- X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_FROM=0.001, RCVD_IN_DNSWL_NONE=-0.0001, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-Spam-Score: -1.3 (-) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -2.3 (--) * guix/scripts/pack.scm (symlink-spec-option-parser): Remove extraneous char-set. Raise an exception when the target is an absolute file name. (guix-pack): Move with-error-handler earlier. * guix/scripts/shell.scm (guix-shell): Likewise. * guix/scripts/environment.scm (guix-environment): Wrap the whole guix-environment* call with the with-error-handling handler. * tests/guix-shell.sh: Add test. * tests/guix-pack.sh: Adjust symlink spec. --- guix/scripts/environment.scm | 294 +++++++++++++++++------------------ guix/scripts/pack.scm | 155 ++++++++++-------- guix/scripts/shell.scm | 77 ++++----- tests/guix-pack.sh | 2 +- 4 files changed, 273 insertions(+), 255 deletions(-) diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index 7174dd72d2..ce299c4533 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -975,158 +975,158 @@ (define-command (guix-environment . args) (category development) (synopsis "spawn one-off software environments (deprecated)") - (guix-environment* (parse-args args))) + (with-error-handling + (guix-environment* (parse-args args)))) (define (guix-environment* opts) "Run the 'guix environment' command on OPTS, an alist resulting for command-line option processing with 'parse-command-line'." - (with-error-handling - (let* ((pure? (assoc-ref opts 'pure)) - (container? (assoc-ref opts 'container?)) - (link-prof? (assoc-ref opts 'link-profile?)) - (symlinks (assoc-ref opts 'symlinks)) - (network? (assoc-ref opts 'network?)) - (no-cwd? (assoc-ref opts 'no-cwd?)) - (emulate-fhs? (assoc-ref opts 'emulate-fhs?)) - (user (assoc-ref opts 'user)) - (bootstrap? (assoc-ref opts 'bootstrap?)) - (system (assoc-ref opts 'system)) - (profile (assoc-ref opts 'profile)) - (command (or (assoc-ref opts 'exec) - ;; Spawn a shell if the user didn't specify - ;; anything in particular. - (if container? - ;; The user's shell is likely not available - ;; within the container. - '("/bin/sh") - (list %default-shell)))) - (mappings (pick-all opts 'file-system-mapping)) - (white-list (pick-all opts 'inherit-regexp))) - - (define store-needed? - ;; Whether connecting to the daemon is needed. - (or container? (not profile))) - - (define-syntax-rule (with-store/maybe store exp ...) - ;; Evaluate EXP... with STORE bound to a connection, unless - ;; STORE-NEEDED? is false, in which case STORE is bound to #f. - (let ((proc (lambda (store) exp ...))) - (if store-needed? - (with-store s - (set-build-options-from-command-line s opts) - (with-build-handler (build-notifier #:use-substitutes? - (assoc-ref opts 'substitutes?) - #:verbosity - (assoc-ref opts 'verbosity) - #:dry-run? - (assoc-ref opts 'dry-run?)) - (proc s))) - (proc #f)))) - - (when container? (assert-container-features)) - - (when (not container?) - (when link-prof? - (leave (G_ "'--link-profile' cannot be used without '--container'~%"))) - (when user - (leave (G_ "'--user' cannot be used without '--container'~%"))) - (when no-cwd? - (leave (G_ "--no-cwd cannot be used without '--container'~%"))) - (when emulate-fhs? - (leave (G_ "'--emulate-fhs' cannot be used without '--container~%'"))) - (when (pair? symlinks) - (leave (G_ "'--symlink' cannot be used without '--container~%'")))) - - (with-store/maybe store - (with-status-verbosity (assoc-ref opts 'verbosity) - (define manifest-from-opts - (options/resolve-packages store opts)) - - (define manifest - (if profile - (profile-manifest profile) - manifest-from-opts)) - - (when (and profile - (> (length (manifest-entries manifest-from-opts)) 0)) - (leave (G_ "'--profile' cannot be used with package options~%"))) - - (when (null? (manifest-entries manifest)) - (warning (G_ "no packages specified; creating an empty environment~%"))) - - ;; Use the bootstrap Guile when requested. - (parameterize ((%graft? (assoc-ref opts 'graft?)) - (%guile-for-build - (and store-needed? - (package-derivation - store - (if bootstrap? - %bootstrap-guile - (default-guile)))))) - (run-with-store store - ;; Containers need a Bourne shell at /bin/sh. - (mlet* %store-monad ((bash (environment-bash container? - bootstrap? - system)) - (prof-drv (if profile - (return #f) - (manifest->derivation - manifest system bootstrap?))) - (profile -> (if profile - (readlink* profile) - (derivation->output-path prof-drv))) - (gc-root -> (assoc-ref opts 'gc-root))) - - ;; First build the inputs. This is necessary even for - ;; --search-paths. Additionally, we might need to build bash for - ;; a container. - (mbegin %store-monad - (mwhen store-needed? - (built-derivations (append - (if prof-drv (list prof-drv) '()) - (if (derivation? bash) (list bash) '())))) - (mwhen gc-root - (register-gc-root profile gc-root)) - - (mwhen (assoc-ref opts 'check?) - (return - (if container? - (warning (G_ "'--check' is unnecessary \ + (let* ((pure? (assoc-ref opts 'pure)) + (container? (assoc-ref opts 'container?)) + (link-prof? (assoc-ref opts 'link-profile?)) + (symlinks (assoc-ref opts 'symlinks)) + (network? (assoc-ref opts 'network?)) + (no-cwd? (assoc-ref opts 'no-cwd?)) + (emulate-fhs? (assoc-ref opts 'emulate-fhs?)) + (user (assoc-ref opts 'user)) + (bootstrap? (assoc-ref opts 'bootstrap?)) + (system (assoc-ref opts 'system)) + (profile (assoc-ref opts 'profile)) + (command (or (assoc-ref opts 'exec) + ;; Spawn a shell if the user didn't specify + ;; anything in particular. + (if container? + ;; The user's shell is likely not available + ;; within the container. + '("/bin/sh") + (list %default-shell)))) + (mappings (pick-all opts 'file-system-mapping)) + (white-list (pick-all opts 'inherit-regexp))) + + (define store-needed? + ;; Whether connecting to the daemon is needed. + (or container? (not profile))) + + (define-syntax-rule (with-store/maybe store exp ...) + ;; Evaluate EXP... with STORE bound to a connection, unless + ;; STORE-NEEDED? is false, in which case STORE is bound to #f. + (let ((proc (lambda (store) exp ...))) + (if store-needed? + (with-store s + (set-build-options-from-command-line s opts) + (with-build-handler (build-notifier #:use-substitutes? + (assoc-ref opts 'substitutes?) + #:verbosity + (assoc-ref opts 'verbosity) + #:dry-run? + (assoc-ref opts 'dry-run?)) + (proc s))) + (proc #f)))) + + (when container? (assert-container-features)) + + (when (not container?) + (when link-prof? + (leave (G_ "'--link-profile' cannot be used without '--container'~%"))) + (when user + (leave (G_ "'--user' cannot be used without '--container'~%"))) + (when no-cwd? + (leave (G_ "--no-cwd cannot be used without '--container'~%"))) + (when emulate-fhs? + (leave (G_ "'--emulate-fhs' cannot be used without '--container~%'"))) + (when (pair? symlinks) + (leave (G_ "'--symlink' cannot be used without '--container~%'")))) + + (with-store/maybe store + (with-status-verbosity (assoc-ref opts 'verbosity) + (define manifest-from-opts + (options/resolve-packages store opts)) + + (define manifest + (if profile + (profile-manifest profile) + manifest-from-opts)) + + (when (and profile + (> (length (manifest-entries manifest-from-opts)) 0)) + (leave (G_ "'--profile' cannot be used with package options~%"))) + + (when (null? (manifest-entries manifest)) + (warning (G_ "no packages specified; creating an empty environment~%"))) + + ;; Use the bootstrap Guile when requested. + (parameterize ((%graft? (assoc-ref opts 'graft?)) + (%guile-for-build + (and store-needed? + (package-derivation + store + (if bootstrap? + %bootstrap-guile + (default-guile)))))) + (run-with-store store + ;; Containers need a Bourne shell at /bin/sh. + (mlet* %store-monad ((bash (environment-bash container? + bootstrap? + system)) + (prof-drv (if profile + (return #f) + (manifest->derivation + manifest system bootstrap?))) + (profile -> (if profile + (readlink* profile) + (derivation->output-path prof-drv))) + (gc-root -> (assoc-ref opts 'gc-root))) + + ;; First build the inputs. This is necessary even for + ;; --search-paths. Additionally, we might need to build bash for + ;; a container. + (mbegin %store-monad + (mwhen store-needed? + (built-derivations (append + (if prof-drv (list prof-drv) '()) + (if (derivation? bash) (list bash) '())))) + (mwhen gc-root + (register-gc-root profile gc-root)) + + (mwhen (assoc-ref opts 'check?) + (return + (if container? + (warning (G_ "'--check' is unnecessary \ when using '--container'; doing nothing~%")) - (validate-child-shell-environment profile manifest)))) - - (cond - ((assoc-ref opts 'search-paths) - (show-search-paths profile manifest #:pure? pure?) - (return #t)) - (container? - (let ((bash-binary - (if bootstrap? - (derivation->output-path bash) - (string-append (derivation->output-path bash) - "/bin/sh")))) - (launch-environment/container #:command command - #:bash bash-binary - #:user user - #:user-mappings mappings - #:profile profile - #:manifest manifest - #:white-list white-list - #:link-profile? link-prof? - #:network? network? - #:map-cwd? (not no-cwd?) - #:emulate-fhs? emulate-fhs? - #:symlinks symlinks - #:setup-hook - (and emulate-fhs? - setup-fhs)))) - - (else - (return - (exit/status - (launch-environment/fork command profile manifest - #:white-list white-list - #:pure? pure?)))))))))))))) + (validate-child-shell-environment profile manifest)))) + + (cond + ((assoc-ref opts 'search-paths) + (show-search-paths profile manifest #:pure? pure?) + (return #t)) + (container? + (let ((bash-binary + (if bootstrap? + (derivation->output-path bash) + (string-append (derivation->output-path bash) + "/bin/sh")))) + (launch-environment/container #:command command + #:bash bash-binary + #:user user + #:user-mappings mappings + #:profile profile + #:manifest manifest + #:white-list white-list + #:link-profile? link-prof? + #:network? network? + #:map-cwd? (not no-cwd?) + #:emulate-fhs? emulate-fhs? + #:symlinks symlinks + #:setup-hook + (and emulate-fhs? + setup-fhs)))) + + (else + (return + (exit/status + (launch-environment/fork command profile manifest + #:white-list white-list + #:pure? pure?))))))))))))) ;;; Local Variables: ;;; eval: (put 'with-store/maybe 'scheme-indent-function 1) diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index e3bddc4274..a101900736 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -42,6 +42,7 @@ (define-module (guix scripts pack) #:use-module (guix profiles) #:use-module (guix describe) #:use-module (guix derivations) + #:use-module (guix diagnostics) #:use-module (guix search-paths) #:use-module (guix build-system gnu) #:use-module (guix scripts build) @@ -59,6 +60,7 @@ (define-module (guix scripts pack) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) #:use-module (srfi srfi-26) + #:use-module (srfi srfi-35) #:use-module (srfi srfi-37) #:use-module (ice-9 match) #:export (symlink-spec-option-parser @@ -163,12 +165,27 @@ (define str (string-join names "-")) ((names ... _) (loop names)))))) (define (symlink-spec-option-parser opt name arg result) - "A SRFI-37 option parser for the --symlink option." + "A SRFI-37 option parser for the --symlink option. The symlink spec accepts +the link file name as its left-hand side value and its target as its +right-hand side value. The target must be a relative link." ;; Note: Using 'string-split' allows us to handle empty ;; TARGET (as in "/opt/guile=", meaning that /opt/guile is ;; a symlink to the profile) correctly. - (match (string-split arg (char-set #\=)) + (match (string-split arg #\=) ((source target) + (when (string-prefix? "/" target) + (raise-exception + (make-compound-condition + (formatted-message (G_ "symlink target is absolute: '~a'~%") target) + (condition + (&fix-hint (hint (format #f (G_ "The target of the symlink must be +relative rather than absolute, as it is relative to the profile created. +Perhaps the source and target components of the symlink spec were inverted? +Below is a valid example, where the @file{/usr/bin/env} symbolic link is to +target the profile's @file{bin/env} file: +@example +--symlink=/usr/bin/env=bin/env +@end example")))))))) (let ((symlinks (assoc-ref result 'symlinks))) (alist-cons 'symlinks `((,source -> ,target) ,@symlinks) @@ -1310,74 +1327,74 @@ (define-command (guix-pack . args) (category development) (synopsis "create application bundles") - (define opts - (parse-command-line args %options (list %default-options))) - - (define maybe-package-argument - ;; Given an option pair, return a package, a package/output tuple, or #f. - (match-lambda - (('argument . spec) - (call-with-values - (lambda () - (specification->package+output spec)) - list)) - (('expression . exp) - (read/eval-package-expression exp)) - (x #f))) - - (define (manifest-from-args store opts) - (let* ((transform (options->transformation opts)) - (packages (map (match-lambda - (((? package? package) output) - (list (transform package) output)) - ((? package? package) - (list (transform package) "out"))) - (reverse - (filter-map maybe-package-argument opts)))) - (manifests (filter-map (match-lambda - (('manifest . file) file) - (_ #f)) - opts))) - (define with-provenance - (if (assoc-ref opts 'save-provenance?) - (lambda (manifest) - (map-manifest-entries - (lambda (entry) - (let ((entry (manifest-entry-with-provenance entry))) - (unless (assq 'provenance (manifest-entry-properties entry)) - (warning (G_ "could not determine provenance of package ~a~%") - (manifest-entry-name entry))) - entry)) - manifest)) - identity)) - - (with-provenance - (cond - ((and (not (null? manifests)) (not (null? packages))) - (leave (G_ "both a manifest and a package list were given~%"))) - ((not (null? manifests)) - (concatenate-manifests - (map (lambda (file) - (let ((user-module (make-user-module - '((guix profiles) (gnu))))) - (load* file user-module))) - manifests))) - (else - (packages->manifest packages)))))) - - (define (process-file-arg opts name) - ;; Validate that the file exists and return it as a object, - ;; else #f. - (let ((value (assoc-ref opts name))) - (match value - ((and (? string?) (not (? file-exists?))) - (leave (G_ "file provided with option ~a does not exist: ~a~%") - (string-append "--" (symbol->string name)) value)) - ((? string?) - (local-file value)) - (#f #f)))) - (with-error-handling + (define opts + (parse-command-line args %options (list %default-options))) + + (define maybe-package-argument + ;; Given an option pair, return a package, a package/output tuple, or #f. + (match-lambda + (('argument . spec) + (call-with-values + (lambda () + (specification->package+output spec)) + list)) + (('expression . exp) + (read/eval-package-expression exp)) + (x #f))) + + (define (manifest-from-args store opts) + (let* ((transform (options->transformation opts)) + (packages (map (match-lambda + (((? package? package) output) + (list (transform package) output)) + ((? package? package) + (list (transform package) "out"))) + (reverse + (filter-map maybe-package-argument opts)))) + (manifests (filter-map (match-lambda + (('manifest . file) file) + (_ #f)) + opts))) + (define with-provenance + (if (assoc-ref opts 'save-provenance?) + (lambda (manifest) + (map-manifest-entries + (lambda (entry) + (let ((entry (manifest-entry-with-provenance entry))) + (unless (assq 'provenance (manifest-entry-properties entry)) + (warning (G_ "could not determine provenance of package ~a~%") + (manifest-entry-name entry))) + entry)) + manifest)) + identity)) + + (with-provenance + (cond + ((and (not (null? manifests)) (not (null? packages))) + (leave (G_ "both a manifest and a package list were given~%"))) + ((not (null? manifests)) + (concatenate-manifests + (map (lambda (file) + (let ((user-module (make-user-module + '((guix profiles) (gnu))))) + (load* file user-module))) + manifests))) + (else + (packages->manifest packages)))))) + + (define (process-file-arg opts name) + ;; Validate that the file exists and return it as a object, + ;; else #f. + (let ((value (assoc-ref opts name))) + (match value + ((and (? string?) (not (? file-exists?))) + (leave (G_ "file provided with option ~a does not exist: ~a~%") + (string-append "--" (symbol->string name)) value)) + ((? string?) + (local-file value)) + (#f #f)))) + (with-store store (with-status-verbosity (assoc-ref opts 'verbosity) ;; Set the build options before we do anything else. diff --git a/guix/scripts/shell.scm b/guix/scripts/shell.scm index 7a379122ae..2fc1dc942a 100644 --- a/guix/scripts/shell.scm +++ b/guix/scripts/shell.scm @@ -534,43 +534,44 @@ (define-command (guix-shell . args) (category development) (synopsis "spawn one-off software environments") - (define (cache-entries directory) - (filter-map (match-lambda - ((or "." "..") #f) - (file (string-append directory "/" file))) - (or (scandir directory) '()))) - - (define* (entry-expiration file) - ;; Return the time at which FILE, a cached profile, is considered expired. - (match (false-if-exception (lstat file)) - (#f 0) ;FILE may have been deleted in the meantime - (st (+ (stat:atime st) (* 60 60 24 7))))) - - (define opts - (parse-args args)) - - (define interactive? - (not (assoc-ref opts 'exec))) - - (if (assoc-ref opts 'check?) - (record-hint 'shell-check) - (when (and interactive? - (not (hint-given? 'shell-check)) - (not (assoc-ref opts 'container?)) - (not (assoc-ref opts 'search-paths))) - (display-hint (G_ "Consider passing the @option{--check} option once + (with-error-handling + (define (cache-entries directory) + (filter-map (match-lambda + ((or "." "..") #f) + (file (string-append directory "/" file))) + (or (scandir directory) '()))) + + (define* (entry-expiration file) + ;; Return the time at which FILE, a cached profile, is considered expired. + (match (false-if-exception (lstat file)) + (#f 0) ;FILE may have been deleted in the meantime + (st (+ (stat:atime st) (* 60 60 24 7))))) + + (define opts + (parse-args args)) + + (define interactive? + (not (assoc-ref opts 'exec))) + + (if (assoc-ref opts 'check?) + (record-hint 'shell-check) + (when (and interactive? + (not (hint-given? 'shell-check)) + (not (assoc-ref opts 'container?)) + (not (assoc-ref opts 'search-paths))) + (display-hint (G_ "Consider passing the @option{--check} option once to make sure your shell does not clobber environment variables."))) ) - ;; Clean the cache in EXIT-HOOK so that (1) it happens after potential use - ;; of cached profiles, and (2) cleanup actually happens, even when - ;; 'guix-environment*' calls 'exit'. - (add-hook! exit-hook - (lambda _ - (maybe-remove-expired-cache-entries - (%profile-cache-directory) - cache-entries - #:entry-expiration entry-expiration))) - - (if (assoc-ref opts 'export-manifest?) - (export-manifest opts (current-output-port)) - (guix-environment* opts))) + ;; Clean the cache in EXIT-HOOK so that (1) it happens after potential use + ;; of cached profiles, and (2) cleanup actually happens, even when + ;; 'guix-environment*' calls 'exit'. + (add-hook! exit-hook + (lambda _ + (maybe-remove-expired-cache-entries + (%profile-cache-directory) + cache-entries + #:entry-expiration entry-expiration))) + + (if (assoc-ref opts 'export-manifest?) + (export-manifest opts (current-output-port)) + (guix-environment* opts)))) diff --git a/tests/guix-pack.sh b/tests/guix-pack.sh index f19a0f754e..6fc9e3723b 100644 --- a/tests/guix-pack.sh +++ b/tests/guix-pack.sh @@ -103,7 +103,7 @@ fi guix pack --dry-run --bootstrap -f docker guile-bootstrap # Build a Docker image with a symlink. -guix pack --dry-run --bootstrap -f docker -S /opt/gnu=/ guile-bootstrap +guix pack --dry-run --bootstrap -f docker -S /opt/gnu= guile-bootstrap # Build a tarball pack of cross-compiled software. Use coreutils because # guile-bootstrap is not intended to be cross-compiled. -- 2.37.3 From debbugs-submit-bounces@debbugs.gnu.org Thu Nov 10 08:43:03 2022 Received: (at control) by debbugs.gnu.org; 10 Nov 2022 13:43:03 +0000 Received: from localhost ([127.0.0.1]:42288 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ot7pf-0002j5-C6 for submit@debbugs.gnu.org; Thu, 10 Nov 2022 08:43:03 -0500 Received: from mail-qk1-f175.google.com ([209.85.222.175]:44858) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ot7pd-0002i6-Vt for control@debbugs.gnu.org; Thu, 10 Nov 2022 08:43:02 -0500 Received: by mail-qk1-f175.google.com with SMTP id z17so1044440qki.11 for ; Thu, 10 Nov 2022 05:43:01 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20210112; h=subject:from:to:message-id:date:from:to:cc:subject:date:message-id :reply-to; bh=XznHWN5gCjLIb7gHi+dXVh/5KrlVpERONzWgUE6jVws=; b=n/hacJzCrrW7uPzQ2I8zWs42a0f9eAdjo6fTTVqfFM5XMxzQi2RNw2XsNxsbXcuBGS Q/sSkqUyADV3ek+qQSq0maICiocV3L7vYRsMoAyGpdoX0OgkB03bfE9Suz+Uku6e/YCD K7zjJcNZ9GacyAsVF542DzJAoXvqZNJDyKcFYCyueglHSpuDeGQMXEx3kQGo/SE6d+BP /nLn0nIArNKdex7pJgL9ypYhdNZHZBzKCxAG0pS9Zzfy+JTz4F+egvduJDM3ep+WHrdS jypybQZuqhley3BW+2Rrvg/GlcRIqZitXf1xykLMDWX50MEUnIU1EP2FsTkiqu/VCb9f Hq+A== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=subject:from:to:message-id:date:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=XznHWN5gCjLIb7gHi+dXVh/5KrlVpERONzWgUE6jVws=; b=PSNxxFOZjBhkJ6j/+Lwhnvk/vb6VBThJnrNQfVz+p+EtAZkq02ZqRilMyjdGLkVUMo bLWhIraLw01cGF+VKGR9Y/Tt3LrhoPVSZJ8LyAJ1Zs83xoEJDThw8H6p59jp61B418+a nmKPNSYukYqon7NG+2iTCC0GUQ0+7WoN0TCjwqvW/E1J0QGTrheMjlreVmno31DJl2Sm Q/d9eLPvmdGkJbuHdRFdLEUmWWT8d8lIHyjuSkc0asgmn880NwMpoawOPmujB3T2NBp4 y8osjK9mXGB2okAkKePlolxYh8LtU50Hk85ubAPCpSFYWXkKdAo5QwSOtXRXaGGOiKab AlEQ== X-Gm-Message-State: ACrzQf1/R3cIoR+rUZTZlEcw21JnE4Ao6LOUKFoNcv9hwufiTkrhUPdu RQYwTIyy+nBWC3buQAKqHzl6xffJIsE= X-Google-Smtp-Source: AMsMyM58YGN0WjOzRPhMo3QQp4XFRpCyk/3Z42FR1XU09QcW6GtB388BexXYKpenXQkO8UMupHtnHg== X-Received: by 2002:a37:53c7:0:b0:6fa:4b14:e071 with SMTP id h190-20020a3753c7000000b006fa4b14e071mr35757729qkb.230.1668087776355; Thu, 10 Nov 2022 05:42:56 -0800 (PST) Received: from hurd ([2607:fad8:4:3::1001]) by smtp.gmail.com with ESMTPSA id m5-20020ac84445000000b003a51e8ef03dsm11254623qtn.62.2022.11.10.05.42.55 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 10 Nov 2022 05:42:56 -0800 (PST) Date: Thu, 10 Nov 2022 08:42:55 -0500 Message-Id: <87v8nnvsbk.fsf@gmail.com> To: control@debbugs.gnu.org From: Maxim Cournoyer Subject: control message for bug #59163 X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: control X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) forcemerge 59163 59164 quit From debbugs-submit-bounces@debbugs.gnu.org Thu Nov 10 08:43:21 2022 Received: (at control) by debbugs.gnu.org; 10 Nov 2022 13:43:22 +0000 Received: from localhost ([127.0.0.1]:42291 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ot7px-0002jn-M4 for submit@debbugs.gnu.org; Thu, 10 Nov 2022 08:43:21 -0500 Received: from mail-qv1-f42.google.com ([209.85.219.42]:43953) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ot7pw-0002jb-3H for control@debbugs.gnu.org; Thu, 10 Nov 2022 08:43:20 -0500 Received: by mail-qv1-f42.google.com with SMTP id c8so1353180qvn.10 for ; Thu, 10 Nov 2022 05:43:20 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20210112; h=subject:from:to:message-id:date:from:to:cc:subject:date:message-id :reply-to; bh=zxD9xhBFIoOBax9tCeYsKMzgotmtmhdoVcNi0lEFyxM=; b=bpZp9BnecBjyMagNGmHCg/RTKcdtwZXsYHDL07BpVDRBDE5VRieMD3yN/TLsTZANrZ luSvg0yXPnqS3hKSd5n4oVo5wS2iJTIw9c2cf/KXTZdyhDkNztQGPz3dL7i7G3V7Kz4V 1MzVTj1R14S6GwmGenmmKUGX9h+ZZ/0iG5bKcYUGFS3XX8RnxrWeAg6PWt3dj7ga/hAy zy5Hi5TAEsaZE9+2c0qfKXQ7/MLxE7ymx2HvqJQxDiucpPPALWjBlVJHjihetXI6NRk3 6VzWEZRJRZwuDIiiRZ5Z1RL0UFJ4j9tJxxRiA5p697hhsLMvAKsMiwmAR277yHF/6OO/ u4lg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=subject:from:to:message-id:date:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=zxD9xhBFIoOBax9tCeYsKMzgotmtmhdoVcNi0lEFyxM=; b=qYwEgmSmY5mYYhw0Nbt8uDiZJZXy/qtQV9K5i5qoT3XKAUMSF/CIe9vBT3tmlZz7uR h73gTO123GdhOS0Pik2mCxO/B07AQSK3jGrj8puyLorSOpGZweCjEudr4oAfni0OV90H rWeC5cjr8XyBiNTfWy31kamJRGiKeQZ8PnxVz6uETd8XHfDogH+AjT9G7FnMw/pikrwZ X3EGTWYIZUhrtHQh0+6mYab8IV8xYBX40QBAIUWVvH6f/0++T9msQq4YOEiSoekpJYSq dEh8xrNAyWum3vDuEZvVjZ7nz/GLolW2chAGYiihuVlnaSDv/nVam9D8jTooNUeryjnO 53iQ== X-Gm-Message-State: ACrzQf1uuDz0xbNNSl19UG+iGxRARAzVSFVSrLTPBR7/1iulZvYuJfnv oYzuX0/oM2/TmHdSORJhWm/1erIklq4= X-Google-Smtp-Source: AMsMyM5IXVysB1wwV2TAejvFSW18glvyghByjLe2yrIbX0ldTS8C4JMiuqzh4bv5a0rrDtZy9vsIpg== X-Received: by 2002:ad4:5eca:0:b0:4ba:535a:6d45 with SMTP id jm10-20020ad45eca000000b004ba535a6d45mr58952419qvb.56.1668087794494; Thu, 10 Nov 2022 05:43:14 -0800 (PST) Received: from hurd ([2607:fad8:4:3::1001]) by smtp.gmail.com with ESMTPSA id j11-20020a05620a410b00b006ce40fbb8f6sm13046337qko.21.2022.11.10.05.43.14 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 10 Nov 2022 05:43:14 -0800 (PST) Date: Thu, 10 Nov 2022 08:43:13 -0500 Message-Id: <87tu37vsb2.fsf@gmail.com> To: control@debbugs.gnu.org From: Maxim Cournoyer Subject: control message for bug #59164 X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: control X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) forcemerge 59164 58812 quit From debbugs-submit-bounces@debbugs.gnu.org Thu Nov 17 12:31:48 2022 Received: (at control) by debbugs.gnu.org; 17 Nov 2022 17:31:48 +0000 Received: from localhost ([127.0.0.1]:34246 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ovijr-0005F6-SG for submit@debbugs.gnu.org; Thu, 17 Nov 2022 12:31:48 -0500 Received: from eggs.gnu.org ([209.51.188.92]:35792) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ovijq-0005Eu-17 for control@debbugs.gnu.org; Thu, 17 Nov 2022 12:31:47 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1ovijj-0007Ou-62 for control@debbugs.gnu.org; Thu, 17 Nov 2022 12:31:40 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-version:Subject:From:To:Date:in-reply-to: references; bh=vPR22pr2GkK2gcZ/EADNWgW7PB6mFnoXpSB+1AYBIFY=; b=c+nTNyh95eWRsx nNRSILzifwIshsPmI4D/CxT7o/a6/KdreeMRc6SrJqs9mC4b/XG+UQTAOlVAH7nI5GvTF+tJZXMNl S4MRNx0kTVjd8aaw7S2FucVLin1ygAzm4fUuTQH0uE+5aXSNr+GiBhTPX1e0Ly3W9Oqxt8EkGtSKv +xMoGKv7FTjArWPFpZqe6jNHxHBG1fAvvWdLh/M0cVV3U8jhQ42StGKslNuYNY7Omz3cZmBukjz9k p5BCJ7OsIePxjEmVaNnrk94vtdYnYvQplRhqvxEhSxipOHOsZ/m79bZFp0YWceC9gS07DJFrc5mzW r/EW6m+TghBcwGiMjmlw==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201] helo=ribbon) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1ovijh-00074P-GA for control@debbugs.gnu.org; Thu, 17 Nov 2022 12:31:38 -0500 Date: Thu, 17 Nov 2022 18:31:35 +0100 Message-Id: <87zgcpfpxk.fsf@gnu.org> To: control@debbugs.gnu.org From: =?utf-8?Q?Ludovic_Court=C3=A8s?= Subject: control message for bug #59164 MIME-version: 1.0 Content-type: text/plain; charset=utf-8 Content-Transfer-Encoding: 8bit X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: control X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) retitle 59164 [PATCH] Add '--symlink' to 'guix shell' quit