bug#45570: [PATCH] system: Assert, that user and group names are unique.

[Leo Prikler]

*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