(address . guix-patches@gnu.org)
20211221193646.16849-2-brice@waegenei.re
* gnu/build/activation.scm (lchown-recursive): New procedure.
---
gnu/build/activation.scm | 20 +++++++++++++++++++-
1 file changed, 19 insertions(+), 1 deletion(-)
Toggle diff (40 lines)
diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm
index 9f6126023c..fff2d61b13 100644
--- a/gnu/build/activation.scm
+++ b/gnu/build/activation.scm
@@ -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)
--
2.34.0