diff mbox series

[bug#52454,2/4] activation: Add 'lchown-recursive'.

Message ID 20211212183614.19730-2-brice@waegenei.re
State New
Headers show
Series Ensure correct ownership of directory trees in services.Hello Guix, | expand

Commit Message

Brice Waegeneire Dec. 12, 2021, 6:36 p.m. UTC
* gnu/build/activation.scm (lchown-recursive): New procedure.
---
 gnu/build/activation.scm | 22 ++++++++++++++++++++--
 1 file changed, 20 insertions(+), 2 deletions(-)
diff mbox series

Patch

diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm
index 9f6126023c..79c835a045 100644
--- a/gnu/build/activation.scm
+++ b/gnu/build/activation.scm
@@ -30,7 +30,7 @@  (define-module (gnu build activation)
   #:use-module (gnu build accounts)
   #:use-module (gnu build linux-boot)
   #:use-module (guix build utils)
-  #:use-module ((guix build syscalls) #:select (with-file-lock))
+  #:use-module ((guix build syscalls) #:select (with-file-lock lchown))
   #:use-module (ice-9 ftw)
   #:use-module (ice-9 match)
   #:use-module (ice-9 vlist)
@@ -46,7 +46,8 @@  (define-module (gnu build activation)
             activate-firmware
             activate-ptrace-attach
             activate-current-system
-            mkdir-p/perms))
+            mkdir-p/perms
+            lchown-recursive))
 
 ;;; Commentary:
 ;;;
@@ -105,6 +106,23 @@  (define (mkdir-p/perms directory owner bits)
   (chown directory (passwd:uid owner) (passwd:gid owner))
   (chmod directory bits))
 
+(define (lchown-recursive file owner group)
+  "As 'lchown' but recursively, change ownership of FILE to the integer values
+OWNER and GROUP without dereferencing symbolic links it encounter."
+  (nftw file
+        (lambda (filename statinfo flag base level)
+          (catch 'system-error
+            (lambda ()
+              (when (member flag '(regular directory symlink))
+                (lchown filename owner group)))
+            (lambda args
+              (format (current-error-port)
+                      "warning: failed to chown ~s: ~a~%"
+                      filename
+                      (strerror (system-error-errno args)))))
+          #t)
+        'physical))
+
 (define* (copy-account-skeletons home
                                  #:key
                                  (directory %skeleton-directory)