(address . guix-patches@gnu.org)
8dda4413505b28fedb9588a4064812fe69c19a37.camel@telenet.be
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
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(+)
Toggle diff (93 lines)
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
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(-)
Toggle diff (65 lines)
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
-----BEGIN PGP SIGNATURE-----
iI0EABYIADUWIQTB8z7iDFKP233XAR9J4+4iGRcl7gUCYAcoBBccbWF4aW1lZGV2
b3NAdGVsZW5ldC5iZQAKCRBJ4+4iGRcl7p9bAQCRkEY8GR9Zk1gNIsukVcvFe8lD
9sgIkr1exauJa5tOwAEApZNzOIOncHDBjRv9qk6iv5M5gISUGcY3+pvYRmHYuwc=
=Ru3B
-----END PGP SIGNATURE-----