From: Leo Prikler <leo.prikler@student.tugraz.at>
To: 45570@debbugs.gnu.org
Cc: conjaroy@gmail.com
Subject: bug#45570: [PATCH v2] system: Assert, that user and group names are unique.
Date: Wed, 6 Jan 2021 22:21:49 +0100 [thread overview]
Message-ID: <20210106212148.28720-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 | 38 ++++++++++++++++++++++++++++++++++++++
1 file changed, 38 insertions(+)
diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm
index a69339bc07..4dbd578e1e 100644
--- a/gnu/system/shadow.scm
+++ b/gnu/system/shadow.scm
@@ -20,6 +20,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu system shadow)
+ #:use-module ((guix diagnostics) #:select (formatted-message))
#:use-module (guix records)
#:use-module (guix gexp)
#:use-module (guix store)
@@ -34,6 +35,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 +224,40 @@ for a colorful Guile experience.\\n\\n\"))))\n"))
(rename-file ".nanorc" ".config/nano/nanorc"))
#t))))
+(define (find-duplicates list)
+ (let loop ((table (make-hash-table))
+ (list list))
+ (match list
+ (()
+ (hash-fold (lambda (key value seed)
+ (if (> value 1)
+ (cons key seed)
+ seed))
+ '()
+ table))
+ ((first . rest)
+ (hash-set! table first
+ (1+ (hash-ref table first 0)))
+ (loop table rest)))))
+
+(define (assert-unique-account-names users)
+ (match (find-duplicates (map user-account-name users))
+ (() *unspecified*)
+ (duplicates
+ (raise
+ (formatted-message
+ (G_ "the following accounts appear more than once:~{ ~a~}~%")
+ duplicates)))))
+
+(define (assert-unique-group-names groups)
+ (match (find-duplicates (map user-group-name groups))
+ (() *unspecified*)
+ (duplicates
+ (raise
+ (formatted-message
+ (G_ "the following groups appear more than once:~{ ~a~}~%")
+ duplicates)))))
+
(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 +328,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.30.0
next prev parent reply other threads:[~2021-01-06 21:23 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
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 ` Leo Prikler [this message]
2021-01-07 8:35 ` bug#45570: [PATCH v2] " 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=20210106212148.28720-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).