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 /guix/gexp.scm | |
| parent | 23dc21f05b54ef63daaea9eb301cfddbc4c82ddb (diff) | |
| download | guix-patches-f43ffee90882c2d61b46d69728daa7432be297e4.tar guix-patches-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.
Diffstat (limited to 'guix/gexp.scm')
| -rw-r--r-- | guix/gexp.scm | 19 |
1 files changed, 15 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 |