diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2020-10-01 22:09:58 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2020-10-02 08:11:38 +0200 |
| commit | f43ffee90882c2d61b46d69728daa7432be297e4 (patch) | |
| tree | 78616df51a7950f27f4918b8395b2d1019228aad | |
| parent | 23dc21f05b54ef63daaea9eb301cfddbc4c82ddb (diff) | |
| download | guix-f43ffee90882c2d61b46d69728daa7432be297e4.tar.gz | |
gexp: 'local-file' warns when passed a non-literal relative file name.
Fixes <https://bugs.gnu.org/43736>. Reported by Vitaliy Shatrov <guix.vits@disroot.org>. * guix/gexp.scm (%local-file): Add #:literal? and #:location. Emit a warning when LITERAL? is false and FILE is not absolute. (local-file): In the non-literal case, pass #:location and #:literal?. * po/guix/POTFILES.in: Add guix/gexp.scm. * tests/guix-system.sh: Add test for the warning.
| -rw-r--r-- | guix/gexp.scm | 19 | ||||
| -rw-r--r-- | po/guix/POTFILES.in | 1 | ||||
| -rw-r--r-- | tests/guix-system.sh | 14 |
3 files changed, 30 insertions, 4 deletions
diff --git a/guix/gexp.scm b/guix/gexp.scm index 9d3c52e783..40346b61e1 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -26,6 +26,8 @@ #:use-module (guix derivations) #:use-module (guix grafts) #:use-module (guix utils) + #:use-module (guix diagnostics) + #:use-module (guix i18n) #:use-module (rnrs bytevectors) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) @@ -401,9 +403,15 @@ Here TARGET is bound to the cross-compilation triplet or #f." (define (true file stat) #t) (define* (%local-file file promise #:optional (name (basename file)) - #:key recursive? (select? true)) + #:key + (literal? #t) location + recursive? (select? true)) ;; This intermediate procedure is part of our ABI, but the underlying ;; %%LOCAL-FILE is not. + (when (and (not literal?) (not (string-prefix? "/" file))) + (warning (and=> location source-properties->location) + (G_ "resolving '~a' relative to current directory~%") + file)) (%%local-file file promise name recursive? select?)) (define (absolute-file-name file directory) @@ -443,9 +451,12 @@ appears." rest ...)) ((_ file rest ...) ;; Resolve FILE relative to the current directory. - #'(%local-file file - (delay (absolute-file-name file (getcwd))) - rest ...)) + (with-syntax ((location (datum->syntax s (syntax-source s)))) + #`(%local-file file + (delay (absolute-file-name file (getcwd))) + #:location 'location + #:literal? #f + rest ...))) ((_) #'(syntax-error "missing file name")) (id diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in index f4d020782c..b877fac9df 100644 --- a/po/guix/POTFILES.in +++ b/po/guix/POTFILES.in @@ -76,6 +76,7 @@ guix/scripts/weather.scm guix/scripts/describe.scm guix/scripts/processes.scm guix/scripts/deploy.scm +guix/gexp.scm guix/gnu-maintenance.scm guix/scripts/container.scm guix/scripts/container/exec.scm diff --git a/tests/guix-system.sh b/tests/guix-system.sh index 667e084fcf..957479ede0 100644 --- a/tests/guix-system.sh +++ b/tests/guix-system.sh @@ -297,6 +297,20 @@ EOF guix system build "$tmpdir/config.scm" -n (cd "$tmpdir"; guix system build "config.scm" -n) +# Check that we get a warning when passing 'local-file' a non-literal relative +# file name. +cat > "$tmpdir/config.scm" <<EOF +(use-modules (guix)) + +(define (bad-local-file file) + (local-file file)) + +(bad-local-file "whatever.scm") +EOF +! guix system build "$tmpdir/config.scm" -n +guix system build "$tmpdir/config.scm" -n 2>&1 | \ + grep "config\.scm:4:2: warning:.*whatever.*relative to current directory" + # Searching. guix system search tor | grep "^name: tor" guix system search tor | grep "^shepherdnames: tor" |