*gnu/system/shadow.scm (assert-unique-account-names)
(assert-unique-group-names): New variables.
(account-activation): Use them here.
---
gnu/system/shadow.scm | 28 ++++++++++++++++++++++++++++
1 file changed, 28 insertions(+)
diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm
index a69339bc07..61562f225e 100644
--- a/gnu/system/shadow.scm
+++ b/gnu/system/shadow.scm
@@ -222,6 +222,32 @@ for a colorful Guile experience.\\n\\n\"))))\n"))
(rename-file ".nanorc" ".config/nano/nanorc"))
#t))))
+(define (assert-unique-account-names users)
+ (let loop ((names '())
+ (users users))
+ (unless (null? users)
+ (let ((name (user-account-name (car users))))
+ (if (member name names)
+ (raise (condition
+ (&message
+ (message
+ (format #f (G_ "account with name '~a' found twice")
+ name)))))
+ (loop (cons name names) (cdr users)))))))
+
+(define (assert-unique-group-names groups)
+ (let loop ((names '())
+ (groups groups))
+ (unless (null? groups)
+ (let ((name (user-account-name (car groups))))
+ (if (member name names)
+ (raise (condition
+ (&message
+ (message
+ (format #f (G_ "group with name '~a' found twice")
+ name)))))
+ (loop (cons name names) (cdr groups)))))))
+
(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 +318,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
