[bug#45991] [PATCH core-updates] Move 'mkdir-p/perms' to gnu/build/utils.scm

[Maxime Devos <maximedevos@telenet.be>]

[-- Attachment #1.1: Type: text/plain, Size: 627 bytes --]

Hi Guix,

This is the patch I talked about on IRC. It moves the various inline
definitions of 'mkdir-p/perms' from gnu/services/... to gnu/build/utils.scm.
I've also written a few tests. As this change entails a world rebuild,
this should be applied to core-updates instead of master (as civodul
pointed out).

`make check TESTS=tests/build-utils.scm` succeeds. Building a few packages
for testing will take some time though (due to the world rebuild).

Plenty of parentheses,
Maxime
-- 
Maxime Devos <maximedevos@telenet.be>
PGP Key: C1F3 3EE2 0C52 8FDB 7DD7  011F 49E3 EE22 1917 25EE
Freenode handle: mdevos

[-- Attachment #1.2: 0001-utils-Add-mkdir-p-perms.patch --]
[-- Type: text/x-patch, Size: 3971 bytes --]

From 7611565fcee641f83dd2eadbe7f573c0b2fe4240 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Tue, 19 Jan 2021 18:58:48 +0100
Subject: [PATCH 1/2] utils: Add 'mkdir-p/perms'

* guix/build/utils.scm (mkdir-p/perms): New procedure.
* tests/build-utils.scm: Add test for 'mkdir-p/perms'.
---
 guix/build/utils.scm  | 10 +++++++++
 tests/build-utils.scm | 47 +++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 57 insertions(+)

diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index 419c10195b..9f7b89d9bc 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -59,6 +59,7 @@
             reset-gzip-timestamp
             with-directory-excursion
             mkdir-p
+            mkdir-p/perms
             install-file
             make-file-writable
             copy-recursively
@@ -307,6 +308,15 @@ preserve FILE's modification time."
                  (apply throw args))))))
       (() #t))))
 
+(define (mkdir-p/perms directory owner perms)
+  "Create directory DIR and all its ancestors.
+Also set its user and group to OWNER, and its
+permission bits to PERMS. OWNER must be an
+password database entry as returned by getpwent."
+  (mkdir-p directory)
+  (chown directory (passwd:uid owner) (passwd:gid owner))
+  (chmod directory perms))
+
 (define (install-file file directory)
   "Create DIRECTORY if it does not exist and copy FILE in there under the same
 name."
diff --git a/tests/build-utils.scm b/tests/build-utils.scm
index 654b480ed9..557751c858 100644
--- a/tests/build-utils.scm
+++ b/tests/build-utils.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2012, 2015, 2016, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -241,4 +242,50 @@ print('hello world')"))
                                            "/some/other/path")))
          #f)))))
 
+;; this also tests mkdir-p itself
+(let ((owner (getpwuid (getuid)))
+      (test-bits '(#o700 #o070 #o007)))
+  (test-assert "mkdir-p/perms, creates directory"
+    (call-with-temporary-directory
+     (lambda (directory)
+       (let ((foo (string-append directory "/a/dir")))
+         (mkdir-p/perms foo owner #o700)
+         (file-exists? foo)))))
+  ;; Unfortunately, testing owner != user requires root,
+  ;; and thus cannot be tested here on Linux systems.
+  ;; TODO: test this on GNU/Hurd.
+  (test-equal "mkdir-p/perms, set permission bits of new directories"
+    test-bits
+    (map (lambda (bits)
+           (call-with-temporary-directory
+            (lambda (directory)
+              (let ((foo (string-append directory "/a/dir")))
+                (mkdir-p/perms foo owner bits)
+                ;; Prevent ‘warning: failed to delete /tmp/.../dir: Permission denied’
+                ;; noise in the logs.
+                (let ((perms (stat:perms (stat foo))))
+                  (chmod foo #o700)
+                  perms)))))
+         test-bits))
+  (test-equal "mkdir-p/perms, reset permission bits of old directories"
+    test-bits
+    (map (lambda (bits)
+           (call-with-temporary-directory
+            (lambda (directory)
+              (let ((foo (string-append directory "/a/dir")))
+                (mkdir-p/perms foo owner #o000)
+                (mkdir-p/perms foo owner bits)
+                (let ((perms (stat:perms (stat foo))))
+                  (chmod foo #o700)
+                  perms)))))
+         test-bits))
+  (test-equal "mkdir-p, use umask for creating parent directories"
+    (logxor #o777 (umask))
+    (call-with-temporary-directory
+     (lambda (directory)
+       (let* ((foo (string-append directory "/a/dir"))
+              (foo-parent (dirname foo)))
+         (mkdir-p/perms foo owner #o777)
+         (stat:perms (stat foo-parent)))))))
+
 (test-end)
-- 
2.30.0


[-- Attachment #1.3: 0002-gnu-remove-inline-mkdir-p-perms-definitions.patch --]
[-- Type: text/x-patch, Size: 3644 bytes --]

From 6ebc5f9e390af1d2efaee1c6640724b358434029 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Tue, 19 Jan 2021 19:19:54 +0100
Subject: [PATCH 2/2] gnu: remove inline 'mkdir-p/perms' definitions

* gnu/services/mail.scm (%dovecot-activation): Leave this
  anomalous definition for someone else to figure out.
* gnu/services/dns.scm (%knot-activation): Remove
  inline definition of 'mkdir-p/perms'.
* gnu/services/cups.scm (%cups-activation): Likewise.
---
 gnu/services/cups.scm |  4 ----
 gnu/services/dns.scm  |  4 ----
 gnu/services/mail.scm | 13 ++++++++-----
 3 files changed, 8 insertions(+), 13 deletions(-)

diff --git a/gnu/services/cups.scm b/gnu/services/cups.scm
index 17ed04e58b..5099bbe421 100644
--- a/gnu/services/cups.scm
+++ b/gnu/services/cups.scm
@@ -874,10 +874,6 @@ IPP specifications.")
   (with-imported-modules '((guix build utils))
     #~(begin
         (use-modules (guix build utils))
-        (define (mkdir-p/perms directory owner perms)
-          (mkdir-p directory)
-          (chown directory (passwd:uid owner) (passwd:gid owner))
-          (chmod directory perms))
         (define (build-subject parameters)
           (string-concatenate
            (map (lambda (pair)
diff --git a/gnu/services/dns.scm b/gnu/services/dns.scm
index b339eb0619..cf8e9dac7f 100644
--- a/gnu/services/dns.scm
+++ b/gnu/services/dns.scm
@@ -609,10 +609,6 @@
 (define (knot-activation config)
   #~(begin
       (use-modules (guix build utils))
-      (define (mkdir-p/perms directory owner perms)
-        (mkdir-p directory)
-        (chown directory (passwd:uid owner) (passwd:gid owner))
-        (chmod directory perms))
       (mkdir-p/perms #$(knot-configuration-run-directory config)
                      (getpwnam "knot") #o755)
       (mkdir-p/perms "/var/lib/knot" (getpwnam "knot") #o755)
diff --git a/gnu/services/mail.scm b/gnu/services/mail.scm
index c0f6371104..e17be3197c 100644
--- a/gnu/services/mail.scm
+++ b/gnu/services/mail.scm
@@ -1484,7 +1484,10 @@ greyed out, instead of only later giving \"not selectable\" popup error.
                                         dovecot-configuration-fields)))))))
     #~(begin
         (use-modules (guix build utils))
-        (define (mkdir-p/perms directory owner perms)
+        ;; XXX someone please take a look
+        ;; if the hardcoding of /var/run/dovecot
+        ;; is intended, or a bug. idk
+        (define (mkdir-p/perms-xxx directory owner perms)
           (mkdir-p directory)
           (chown "/var/run/dovecot" (passwd:uid owner) (passwd:gid owner))
           (chmod directory perms))
@@ -1529,12 +1532,12 @@ greyed out, instead of only later giving \"not selectable\" popup error.
               (format (current-error-port)
                       "Failed to create public key at ~a.\n" public-key)))))
         (let ((user (getpwnam "dovecot")))
-          (mkdir-p/perms "/var/run/dovecot" user #o755)
-          (mkdir-p/perms "/var/lib/dovecot" user #o755)
-          (mkdir-p/perms "/etc/dovecot" user #o755)
+          (mkdir-p/perms-xxx "/var/run/dovecot" user #o755)
+          (mkdir-p/perms-xxx "/var/lib/dovecot" user #o755)
+          (mkdir-p/perms-xxx "/etc/dovecot" user #o755)
           (copy-file #$(plain-file "dovecot.conf" config-str)
                      "/etc/dovecot/dovecot.conf")
-          (mkdir-p/perms "/etc/dovecot/private" user #o700)
+          (mkdir-p/perms-xxx "/etc/dovecot/private" user #o700)
           (create-self-signed-certificate-if-absent
            #:private-key "/etc/dovecot/private/default.pem"
            #:public-key "/etc/dovecot/default.pem"
-- 
2.30.0


[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]