[bug#78378,v1,1/3] gexp: Allow file-unions with dangling symlinks.

Message ID 40e225a93a488b887fc770effe8f856c62620d28.1747647920.git.sarg@sarg.org.ru
State New
Headers
Series [bug#78378,v1,1/3] gexp: Allow file-unions with dangling symlinks. |

Commit Message

Sergey Trofimov May 19, 2025, 9:50 a.m. UTC
  * guix/gexp.scm (file-union): Add #:dangling-symlinks? parameter.

Change-Id: I09d44ec785fd7141b02dee2d8dc23ccc499aa933
---
 doc/guix.texi | 12 +++++++-----
 guix/gexp.scm | 19 ++++++++++---------
 2 files changed, 17 insertions(+), 14 deletions(-)


base-commit: 450a361532573a02389530a6a80b7821683ed41b
  

Comments

Maxim Cournoyer May 20, 2025, 11:14 p.m. UTC | #1
Hi Sergey,

I've merged this series with the following small adjustments for 1/3:

--8<---------------cut here---------------start------------->8---
modified   guix/gexp.scm
@@ -2145,7 +2145,7 @@ (define* (mixed-text-file name #:key guile #:rest text)
 
   (computed-file name build #:guile guile))
 
-(define* (file-union name files #:key guile (dangling-symlinks? #f))
+(define* (file-union name files #:key guile dangling-symlinks?)
   "Return a <computed-file> that builds a directory containing all of FILES.
 Each item in FILES must be a two-element list where the first element is the
 file name to use in the new directory, and the second element is a gexp
@@ -2159,29 +2159,29 @@ (define* (file-union name files #:key guile (dangling-symlinks? #f))
                 (\"libvirt/qemu.conf\" ,(plain-file \"qemu.conf\" \"\"))))
 
 This yields an 'etc' directory containing these two files."
-  (computed-file name
-                 (with-imported-modules '((guix build utils))
-                   (gexp
-                    (begin
-                      (use-modules (guix build utils))
-
-                      (mkdir (ungexp output))
-                      (chdir (ungexp output))
-                      (ungexp-splicing
-                       (map (match-lambda
-                              ((target source)
-                               (gexp
-                                (let ((source (ungexp source))
-                                      (target (ungexp target)))
-                                  (unless (or (ungexp dangling-symlinks?)
-                                              (stat source #f))
-                                    (error (format #f "~a points to inexistent file or dangling symlink ~a"
-                                                   target source)))
-
-                                  (mkdir-p (dirname target))
-                                  (symlink source target)))))
-                            files)))))
-                 #:guile guile))
+  (computed-file
+   name
+   (with-imported-modules '((guix build utils))
+     (gexp
+      (begin
+        (use-modules (guix build utils))
+
+        (mkdir (ungexp output))
+        (chdir (ungexp output))
+        (ungexp-splicing
+         (map (match-lambda
+                ((target source)
+                 (gexp
+                  (let ((source (ungexp source))
+                        (target (ungexp target)))
+                    (unless (or (ungexp dangling-symlinks?)
+                                (stat source #f))
+                      (error (format #f "~a points to inexistent file \
+or dangling symlink ~a" target source)))
+                    (mkdir-p (dirname target))
+                    (symlink source target)))))
+              files)))))
+   #:guile guile))
 
 (define (symlink-to target)
   "Return an object that is a symlink to TARGET."
--8<---------------cut here---------------end--------------->8---

Mostly to meet the max line width of 80 columns.

And for 3/3:

--8<---------------cut here---------------start------------->8---
modified   gnu/home/services.scm
@@ -343,7 +343,7 @@ (define (files->files-directory files)
   ;; leading to a build failure of "files.drv".
   (assert-no-duplicates files)
 
-  ;; Allow symlinks to locations out of store
+  ;; Allow symlinks to locations outside the store.
   (file-union "files" files #:dangling-symlinks? #t))
 
 ;; Used by symlink-manager
--8<---------------cut here---------------end--------------->8---

e.g. adding missing punctuation for a standalone comment.

Pushed with commit 11bc17c409.
  

Patch

diff --git a/doc/guix.texi b/doc/guix.texi
index fd86551787..ef8504bb3e 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -12673,11 +12673,13 @@  G-Expressions
 This is the declarative counterpart of @code{text-file*}.
 @end deffn
 
-@deffn {Procedure} file-union name files
-Return a @code{<computed-file>} that builds a directory containing all of @var{files}.
-Each item in @var{files} must be a two-element list where the first element is the
-file name to use in the new directory, and the second element is a gexp
-denoting the target file.  Here's an example:
+@deffn {Procedure} file-union name files [#:dangling-symlinks? #f]
+Return a @code{<computed-file>} that builds a directory containing all
+of @var{files}.  Each item in @var{files} must be a two-element list
+where the first element is the file name to use in the new directory,
+and the second element is a gexp denoting the target file.
+@code{#:dangling-symlinks?} controls if gexps must lower to an existing
+file.  Here's an example:
 
 @lisp
 (file-union "etc"
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 8dd746eee0..85d049e26a 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -2144,7 +2144,7 @@  (define* (mixed-text-file name #:key guile #:rest text)
 
   (computed-file name build #:guile guile))
 
-(define* (file-union name files #:key guile)
+(define* (file-union name files #:key guile (dangling-symlinks? #f))
   "Return a <computed-file> that builds a directory containing all of FILES.
 Each item in FILES must be a two-element list where the first element is the
 file name to use in the new directory, and the second element is a gexp
@@ -2170,14 +2170,15 @@  (define* (file-union name files #:key guile)
                        (map (match-lambda
                               ((target source)
                                (gexp
-                                (begin
-                                  ;; Stat the source to abort early if it does
-                                  ;; not exist.
-                                  (stat (ungexp source))
-
-                                  (mkdir-p (dirname (ungexp target)))
-                                  (symlink (ungexp source)
-                                           (ungexp target))))))
+                                (let ((source (ungexp source))
+                                      (target (ungexp target)))
+                                  (unless (or (ungexp dangling-symlinks?)
+                                              (stat source #f))
+                                    (error (format #f "~a points to inexistent file or dangling symlink ~a"
+                                                   target source)))
+
+                                  (mkdir-p (dirname target))
+                                  (symlink source target)))))
                             files)))))
                  #:guile guile))