aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-10-01 22:09:58 +0200
committerLudovic Courtès <ludo@gnu.org>2020-10-02 08:11:38 +0200
commitf43ffee90882c2d61b46d69728daa7432be297e4 (patch)
tree78616df51a7950f27f4918b8395b2d1019228aad
parent23dc21f05b54ef63daaea9eb301cfddbc4c82ddb (diff)
downloadguix-f43ffee90882c2d61b46d69728daa7432be297e4.tar
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.scm19
-rw-r--r--po/guix/POTFILES.in1
-rw-r--r--tests/guix-system.sh14
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"