From f43ffee90882c2d61b46d69728daa7432be297e4 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 1 Oct 2020 22:09:58 +0200 Subject: gexp: 'local-file' warns when passed a non-literal relative file name. Fixes . Reported by Vitaliy Shatrov . * 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. --- guix/gexp.scm | 19 +++++++++++++++---- 1 file changed, 15 insertions(+), 4 deletions(-) (limited to 'guix/gexp.scm') 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 -- cgit v1.2.3 From 9471aea76ace5c0998d889fc5fbde7a6bcafc654 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 2 Oct 2020 09:29:26 +0200 Subject: gexp: Fix argument ordering in 'local-file' macro. Fixes a regression introduced in f43ffee90882c2d61b46d69728daa7432be297e4. Reported by jonsger on #guix. * guix/gexp.scm (local-file): In the non-literal case, add #:literal? and #:location after REST. --- guix/gexp.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'guix/gexp.scm') diff --git a/guix/gexp.scm b/guix/gexp.scm index 40346b61e1..25e4881d21 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -454,9 +454,9 @@ appears." (with-syntax ((location (datum->syntax s (syntax-source s)))) #`(%local-file file (delay (absolute-file-name file (getcwd))) + rest ... #:location 'location - #:literal? #f - rest ...))) + #:literal? #f))) ((_) #'(syntax-error "missing file name")) (id -- cgit v1.2.3 From 5d4ad8e1be6d60c38577e2f3d92cc5642b12eff0 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 16 Oct 2020 14:55:00 +0200 Subject: gexp: Add 'assume-valid-file-name' syntax for use with 'local-file'. * guix/gexp.scm (assume-valid-file-name): New variable. (local-file): Add clause with (assume-valid-file-name file). --- guix/gexp.scm | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) (limited to 'guix/gexp.scm') diff --git a/guix/gexp.scm b/guix/gexp.scm index 25e4881d21..76fffc4908 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -48,6 +48,7 @@ gexp-input-output gexp-input-native? + assume-valid-file-name local-file local-file? local-file-file @@ -424,6 +425,12 @@ vicinity of DIRECTORY." (string-append directory "/" file)) (else file)))) +(define-syntax-rule (assume-valid-file-name file) + "This is a syntactic keyword to tell 'local-file' that it can assume that +the given file name is valid, even if it's not a string literal, and thus not +warn about it." + file) + (define-syntax local-file (lambda (s) "Return an object representing local file FILE to add to the store; this @@ -442,13 +449,20 @@ where FILE is the entry's absolute file name and STAT is the result of This is the declarative counterpart of the 'interned-file' monadic procedure. It is implemented as a macro to capture the current source directory where it appears." - (syntax-case s () + (syntax-case s (assume-valid-file-name) ((_ file rest ...) (string? (syntax->datum #'file)) ;; FILE is a literal, so resolve it relative to the source directory. #'(%local-file file (delay (absolute-file-name file (current-source-directory))) rest ...)) + ((_ (assume-valid-file-name file) rest ...) + ;; FILE is not a literal, so resolve it relative to the source + ;; directory. Since the user declared FILE is valid, do not pass + ;; #:literal? #f so that we do not warn about it later on. + #'(%local-file file + (delay (absolute-file-name file (current-source-directory))) + rest ...)) ((_ file rest ...) ;; Resolve FILE relative to the current directory. (with-syntax ((location (datum->syntax s (syntax-source s)))) @@ -456,7 +470,7 @@ appears." (delay (absolute-file-name file (getcwd))) rest ... #:location 'location - #:literal? #f))) + #:literal? #f))) ;warn if FILE is relative ((_) #'(syntax-error "missing file name")) (id -- cgit v1.2.3 From 6be71461309bad19dcd96faa151ca691d87f28df Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 18 Oct 2020 00:21:33 +0200 Subject: gexp: 'assume-valid-file-name' has files looked up under the CWD. Fixes a bug introduced in 5d4ad8e1be6d60c38577e2f3d92cc5642b12eff0, whereby files enclosed in 'assume-valid-file-name' would be looked up relative to the source directory instead of relative to the current directory. * guix/gexp.scm (local-file): In the 'assume-valid-file-name' case, look up FILE relative to the current working directory. --- guix/gexp.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'guix/gexp.scm') diff --git a/guix/gexp.scm b/guix/gexp.scm index 76fffc4908..9339b226b7 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -457,11 +457,11 @@ appears." (delay (absolute-file-name file (current-source-directory))) rest ...)) ((_ (assume-valid-file-name file) rest ...) - ;; FILE is not a literal, so resolve it relative to the source + ;; FILE is not a literal, so resolve it relative to the current ;; directory. Since the user declared FILE is valid, do not pass ;; #:literal? #f so that we do not warn about it later on. #'(%local-file file - (delay (absolute-file-name file (current-source-directory))) + (delay (absolute-file-name file (getcwd))) rest ...)) ((_ file rest ...) ;; Resolve FILE relative to the current directory. -- cgit v1.2.3