GNU bug report logs - #52713
[PATCH v2 2/4] activation: Add 'lchown-recursive'.

Message received at submit <at> debbugs.gnu.org:

Received: (at submit) by debbugs.gnu.org; 21 Dec 2021 19:36:58 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Tue Dec 21 14:36:57 2021
Received: from localhost ([127.0.0.1]:55696 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1mzkwT-00077A-HB
	for submit <at> debbugs.gnu.org; Tue, 21 Dec 2021 14:36:57 -0500
Received: from lists.gnu.org ([209.51.188.17]:37524)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <brice@HIDDEN>) id 1mzkwS-00076u-0w
 for submit <at> debbugs.gnu.org; Tue, 21 Dec 2021 14:36:56 -0500
Received: from eggs.gnu.org ([209.51.188.92]:36154)
 by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.90_1) (envelope-from <brice@HIDDEN>) id 1mzkwR-0001wK-EY
 for guix-patches@HIDDEN; Tue, 21 Dec 2021 14:36:55 -0500
Received: from relay1-d.mail.gandi.net ([217.70.183.193]:41335)
 by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.90_1) (envelope-from <brice@HIDDEN>) id 1mzkwP-0004Ek-9p
 for guix-patches@HIDDEN; Tue, 21 Dec 2021 14:36:54 -0500
Received: (Authenticated sender: brice@HIDDEN)
 by relay1-d.mail.gandi.net (Postfix) with ESMTPSA id 7EC24240003
 for <guix-patches@HIDDEN>; Tue, 21 Dec 2021 19:36:50 +0000 (UTC)
From: Brice Waegeneire <brice@HIDDEN>
To: guix-patches@HIDDEN
Subject: [PATCH v2 2/4] activation: Add 'lchown-recursive'.
Date: Tue, 21 Dec 2021 20:36:44 +0100
Message-Id: <20211221193646.16849-2-brice@HIDDEN>
X-Mailer: git-send-email 2.34.0
In-Reply-To: <8735mleoxo.fsf_-_@HIDDEN>
References: <8735mleoxo.fsf_-_@HIDDEN>
MIME-Version: 1.0
Content-Transfer-Encoding: 8bit
Received-SPF: pass client-ip=217.70.183.193; envelope-from=brice@HIDDEN;
 helo=relay1-d.mail.gandi.net
X-Spam_score_int: -25
X-Spam_score: -2.6
X-Spam_bar: --
X-Spam_report: (-2.6 / 5.0 requ) BAYES_00=-1.9, RCVD_IN_DNSWL_LOW=-0.7,
 RCVD_IN_MSPIKE_H3=0.001, RCVD_IN_MSPIKE_WL=0.001, SPF_HELO_NONE=0.001,
 SPF_PASS=-0.001 autolearn=ham autolearn_force=no
X-Spam_action: no action
X-Spam-Score: -1.7 (-)
X-Debbugs-Envelope-To: submit
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -2.7 (--)

* gnu/build/activation.scm (lchown-recursive): New procedure.
---
 gnu/build/activation.scm | 20 +++++++++++++++++++-
 1 file changed, 19 insertions(+), 1 deletion(-)

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