From: Maxim Cournoyer <maxim.cournoyer@gmail.com>
To: 58812@debbugs.gnu.org
Cc: Maxim Cournoyer <maxim.cournoyer@gmail.com>
Subject: [bug#58812] [PATCH 3/5] install: Validate symlink target in evaluate-populate-directive.
Date: Wed, 26 Oct 2022 23:50:58 -0400 [thread overview]
Message-ID: <20221027035100.28852-3-maxim.cournoyer@gmail.com> (raw)
In-Reply-To: <20221027035100.28852-1-maxim.cournoyer@gmail.com>
* gnu/build/install.scm (evaluate-populate-directive): By default, error when
the target of a symlink doesn't exist. Always ensure TARGET ends with "/".
(populate-root-file-system): Call evaluate-populate-directive with
#:error-on-dangling-symlink #t and add comment.
---
gnu/build/install.scm | 60 ++++++++++++++++++++++++++++---------------
1 file changed, 40 insertions(+), 20 deletions(-)
diff --git a/gnu/build/install.scm b/gnu/build/install.scm
index f5c8407b89..15cc29b2c8 100644
--- a/gnu/build/install.scm
+++ b/gnu/build/install.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
+;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -56,19 +57,24 @@ (define (install-boot-config bootcfg bootcfg-location mount-point)
(define* (evaluate-populate-directive directive target
#:key
(default-gid 0)
- (default-uid 0))
+ (default-uid 0)
+ (error-on-dangling-symlink? #t))
"Evaluate DIRECTIVE, an sexp describing a file or directory to create under
directory TARGET. DEFAULT-UID and DEFAULT-GID are the default UID and GID in
the context of the caller. If the directive matches those defaults then,
-'chown' won't be run."
+'chown' won't be run. When ERROR-ON-DANGLING-SYMLINK? is true, abort with an
+error when a dangling symlink would be created."
+ (define target* (if (string-suffix? "/" target)
+ target
+ (string-append target "/")))
(let loop ((directive directive))
(catch 'system-error
(lambda ()
(match directive
(('directory name)
- (mkdir-p (string-append target name)))
+ (mkdir-p (string-append target* name)))
(('directory name uid gid)
- (let ((dir (string-append target name)))
+ (let ((dir (string-append target* name)))
(mkdir-p dir)
;; If called from a context without "root" permissions, "chown"
;; to root will fail. In that case, do not try to run "chown"
@@ -78,27 +84,38 @@ (define* (evaluate-populate-directive directive target
(chown dir uid gid))))
(('directory name uid gid mode)
(loop `(directory ,name ,uid ,gid))
- (chmod (string-append target name) mode))
+ (chmod (string-append target* name) mode))
(('file name)
- (call-with-output-file (string-append target name)
+ (call-with-output-file (string-append target* name)
(const #t)))
(('file name (? string? content))
- (call-with-output-file (string-append target name)
+ (call-with-output-file (string-append target* name)
(lambda (port)
(display content port))))
((new '-> old)
- (let try ()
- (catch 'system-error
- (lambda ()
- (symlink old (string-append target new)))
- (lambda args
- ;; When doing 'guix system init' on the current '/', some
- ;; symlinks may already exists. Override them.
- (if (= EEXIST (system-error-errno args))
- (begin
- (delete-file (string-append target new))
- (try))
- (apply throw args))))))))
+ (let ((new* (string-append target* new)))
+ (let try ()
+ (catch 'system-error
+ (lambda ()
+ (when error-on-dangling-symlink?
+ ;; When the symbolic link points to a relative path,
+ ;; checking if its target exists must be done relative to
+ ;; the link location.
+ (with-directory-excursion (if (string-prefix? "/" old)
+ (getcwd)
+ (dirname new*)) ;relative
+ (unless (file-exists? old)
+ (error (format #f "symlink `~a' points to nonexistent \
+file `~a'" new* old)))))
+ (symlink old new*))
+ (lambda args
+ ;; When doing 'guix system init' on the current '/', some
+ ;; symlinks may already exists. Override them.
+ (if (= EEXIST (system-error-errno args))
+ (begin
+ (delete-file new*)
+ (try))
+ (apply throw args)))))))))
(lambda args
;; Usually we can only get here when installing to an existing root,
;; as with 'guix system init foo.scm /'.
@@ -142,7 +159,10 @@ (define* (populate-root-file-system system target
includes /etc, /var, /run, /bin/sh, etc., and all the symlinks to SYSTEM.
EXTRAS is a list of directives appended to the built-in directives to populate
TARGET."
- (for-each (cut evaluate-populate-directive <> target)
+ ;; It's expected that some symbolic link targets do not exist yet, so do not
+ ;; error on dangling links.
+ (for-each (cut evaluate-populate-directive <> target
+ #:error-on-dangling-symlink? #f)
(append (directives (%store-directory)) extras))
;; Add system generation 1.
--
2.37.3
next prev parent reply other threads:[~2022-10-27 3:54 UTC|newest]
Thread overview: 59+ messages / expand[flat|nested] mbox.gz Atom feed top
2022-10-27 3:41 [bug#58812] [PATCH 0/5] Add --symlink option to 'guix shell' Maxim Cournoyer
2022-10-27 3:50 ` [bug#58812] [PATCH 1/5] Makefile.am: Sort EXTRA_DIST entries Maxim Cournoyer
2022-10-27 3:50 ` [bug#58812] [PATCH 2/5] tests: Add a tests/utils.sh support file Maxim Cournoyer
2022-11-09 21:07 ` [bug#58812] [PATCH 0/5] Add --symlink option to 'guix shell' Ludovic Courtès
2022-11-10 3:38 ` Maxim Cournoyer
2022-11-10 4:23 ` [bug#59164] [PATCH v2 1/4] Makefile.am: Sort EXTRA_DIST entries Maxim Cournoyer
2022-11-10 4:23 ` [bug#59161] [PATCH v2 2/4] install: Validate symlink target in evaluate-populate-directive Maxim Cournoyer
2022-11-10 4:23 ` [bug#59162] [PATCH v2 3/4] guix: shell: Add '--symlink' option Maxim Cournoyer
2022-11-10 4:23 ` [bug#59163] [PATCH v2 4/4] shell: Detect --symlink spec problems early Maxim Cournoyer
2022-10-27 3:50 ` Maxim Cournoyer [this message]
2022-11-09 21:06 ` [bug#58812] [PATCH 0/5] Add --symlink option to 'guix shell' Ludovic Courtès
2022-11-10 3:37 ` Maxim Cournoyer
2022-11-17 17:37 ` [bug#59164] Coding style: similarly-named variables Ludovic Courtès
2022-11-17 18:44 ` [bug#58812] " zimoun
2022-11-18 17:02 ` Maxim Cournoyer
2022-11-21 15:02 ` zimoun
2022-11-21 15:52 ` [bug#59164] " zimoun
2022-11-21 20:55 ` Maxim Cournoyer
2022-11-22 14:35 ` [bug#59164] " zimoun
2022-11-25 15:23 ` Guile debugger workgroup? (was: Coding style: similarly-named variables) Maxim Cournoyer
2022-11-26 11:22 ` Guile debugger workgroup? Ludovic Courtès
2022-11-27 3:16 ` Maxim Cournoyer
2022-11-28 10:53 ` Ludovic Courtès
2022-11-28 13:41 ` Attila Lendvai
2022-11-28 14:50 ` Maxim Cournoyer
2022-11-29 8:46 ` Ludovic Courtès
2022-11-30 3:44 ` Attila Lendvai
2022-11-27 12:04 ` zimoun
2022-11-28 0:27 ` Maxim Cournoyer
2022-11-28 11:06 ` Ludovic Courtès
2022-11-28 12:31 ` zimoun
2022-11-27 20:46 ` Attila Lendvai
2022-11-28 0:41 ` David Pirotte
2022-11-28 0:45 ` David Pirotte
2022-11-28 2:06 ` Maxim Cournoyer
2022-11-28 7:22 ` Joshua Branson
2022-11-28 11:09 ` Ludovic Courtès
2022-11-28 14:12 ` Attila Lendvai
2022-11-29 8:54 ` Ludovic Courtès
2022-11-28 12:24 ` Guile debugger workgroup? (was: Coding style: similarly-named variables) Csepp
2022-11-30 7:09 ` Guile debugger workgroup? Jannneke Nieuwenhuizen
2022-11-26 14:47 ` [bug#58812] [bug#59164] Coding style: similarly-named variables Ludovic Courtès
2022-11-17 20:34 ` Maxim Cournoyer
2022-11-20 10:46 ` [bug#58812] " Ludovic Courtès
2022-10-27 3:50 ` [bug#58812] [PATCH 4/5] guix: shell: Add '--symlink' option Maxim Cournoyer
2022-11-09 20:58 ` [bug#58812] [PATCH 0/5] Add --symlink option to 'guix shell' Ludovic Courtès
2022-11-10 3:10 ` Maxim Cournoyer
2022-11-10 14:17 ` Ludovic Courtès
2022-11-10 14:49 ` Maxim Cournoyer
2022-11-10 15:16 ` Maxim Cournoyer
2022-11-14 9:18 ` Ludovic Courtès
2022-11-10 16:05 ` [bug#58812] [PATCH v3 1/4] Makefile.am: Sort EXTRA_DIST entries Maxim Cournoyer
2022-11-10 16:05 ` [bug#58812] [PATCH v3 2/4] install: Validate symlink target in evaluate-populate-directive Maxim Cournoyer
2022-11-10 16:05 ` [bug#58812] [PATCH v3 3/4] guix: shell: Add '--symlink' option Maxim Cournoyer
2022-11-10 16:05 ` [bug#58812] [PATCH v3 4/4] shell: Detect --symlink spec problems early Maxim Cournoyer
2022-11-16 19:03 ` [bug#58812] [PATCH 0/5] Add --symlink option to 'guix shell' zimoun
2022-11-16 19:34 ` Maxim Cournoyer
2022-10-27 3:51 ` [bug#58812] [PATCH 5/5] shell: Detect --symlink spec problems early Maxim Cournoyer
2022-11-15 21:24 ` bug#58812: [PATCH v3 1/4] " Maxim Cournoyer
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20221027035100.28852-3-maxim.cournoyer@gmail.com \
--to=maxim.cournoyer@gmail.com \
--cc=58812@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.