From: Leo Prikler <leo.prikler@student.tugraz.at>
To: 45570@debbugs.gnu.org
Cc: conjaroy@gmail.com
Subject: bug#45570: [PATCH] system: Assert, that user and group names are unique.
Date: Sat, 2 Jan 2021 06:57:29 +0100 [thread overview]
Message-ID: <20210102055728.22594-1-leo.prikler@student.tugraz.at> (raw)
In-Reply-To: <CABWzUjVOFSgBUw-Wyx-+BWL2VWhfJR=CGutVZZP8ri2KrdtUnw@mail.gmail.com>
*gnu/system/shadow.scm (find-duplicates): New variable.
(assert-unique-account-names, assert-unique-group-names): New variables.
(account-activation): Use them here.
---
gnu/system/shadow.scm | 35 +++++++++++++++++++++++++++++++++++
1 file changed, 35 insertions(+)
diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm
index a69339bc07..3a5ea4dc70 100644
--- a/gnu/system/shadow.scm
+++ b/gnu/system/shadow.scm
@@ -34,6 +34,7 @@
#:use-module ((gnu packages admin)
#:select (shadow))
#:use-module (gnu packages bash)
+ #:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
@@ -222,6 +223,38 @@ for a colorful Guile experience.\\n\\n\"))))\n"))
(rename-file ".nanorc" ".config/nano/nanorc"))
#t))))
+(define (find-duplicates list =)
+ (match list
+ ('() '())
+ ((first . rest)
+ (if (member first rest =) ; (srfi srfi-1) member
+ (cons first (find-duplicates rest =))
+ (find-duplicates rest =)))))
+
+(define (assert-unique-account-names users)
+ (for-each
+ (lambda (account)
+ (raise (condition
+ (&message
+ (message
+ (format #f (G_ "account with name '~a' found twice.")
+ (user-account-name account)))))))
+ (find-duplicates users (lambda (alice bob)
+ (string=? (user-account-name alice)
+ (user-account-name bob))))))
+
+(define (assert-unique-group-names groups)
+ (for-each
+ (lambda (group)
+ (raise (condition
+ (&message
+ (message
+ (format #f (G_ "group with name '~a' found twice.")
+ (user-group-name group)))))))
+ (find-duplicates groups (lambda (red blue)
+ (string=? (user-group-name red)
+ (user-group-name blue))))))
+
(define (assert-valid-users/groups users groups)
"Raise an error if USERS refer to groups not listed in GROUPS."
(let ((groups (list->set (map user-group-name groups))))
@@ -292,6 +325,8 @@ group."
(define group-specs
(map user-group->gexp groups))
+ (assert-unique-account-names accounts)
+ (assert-unique-group-names groups)
(assert-valid-users/groups accounts groups)
;; Add users and user groups.
--
2.29.2
next prev parent reply other threads:[~2021-01-02 5:59 UTC|newest]
Thread overview: 15+ messages / expand[flat|nested] mbox.gz Atom feed top
2020-12-31 18:14 bug#45570: operating-system definitions allow duplicate passwd and group entries Jason Conroy
2021-01-01 11:13 ` bug#45570: [PATCH] system: Assert, that user and group names are unique Leo Prikler
2021-01-02 1:16 ` Danny Milosavljevic
2021-01-02 5:57 ` Leo Prikler [this message]
2021-01-06 9:56 ` Ludovic Courtès
2021-01-06 12:34 ` Leo Prikler
2021-01-06 13:32 ` Ludovic Courtès
2021-01-06 21:00 ` Leo Prikler
2021-01-07 8:29 ` Ludovic Courtès
2021-01-06 21:21 ` bug#45570: [PATCH v2] " Leo Prikler
2021-01-07 8:35 ` Ludovic Courtès
2021-01-07 11:13 ` Leo Prikler
2021-01-07 11:10 ` bug#45570: [PATCH v3] " Leo Prikler
2021-01-11 13:09 ` Ludovic Courtès
2021-01-11 15:06 ` Leo Prikler
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20210102055728.22594-1-leo.prikler@student.tugraz.at \
--to=leo.prikler@student.tugraz.at \
--cc=45570@debbugs.gnu.org \
--cc=conjaroy@gmail.com \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).