summaryrefslogtreecommitdiff
path: root/gnu/system/shadow.scm
diff options
context:
space:
mode:
authorJonathan Brielmaier <jonathan.brielmaier@web.de>2021-01-12 22:57:22 +0100
committerJonathan Brielmaier <jonathan.brielmaier@web.de>2021-01-12 23:53:53 +0100
commit8488f45b6e05d646224cc2b410497ddf9864c612 (patch)
treea9b19e345095e375916ed55818bf70d5a1bbdf1c /gnu/system/shadow.scm
parentb1cb9e67a60b094b48c05afa992a602251d3feae (diff)
Revert "system: Assert, that user and group names are unique."
This reverts commit a3002104a84c60556b6616d100cb98019e48759d, which breaks certain system configurations like: $ guix system reconfigure config.scm guix system: error: the following groups appear more than once: lp
Diffstat (limited to 'gnu/system/shadow.scm')
-rw-r--r--gnu/system/shadow.scm44
1 files changed, 0 insertions, 44 deletions
diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm
index 183b2cd387e..a69339bc074 100644
--- a/gnu/system/shadow.scm
+++ b/gnu/system/shadow.scm
@@ -20,7 +20,6 @@
20;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. 20;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
21 21
22(define-module (gnu system shadow) 22(define-module (gnu system shadow)
23 #:use-module ((guix diagnostics) #:select (formatted-message))
24 #:use-module (guix records) 23 #:use-module (guix records)
25 #:use-module (guix gexp) 24 #:use-module (guix gexp)
26 #:use-module (guix store) 25 #:use-module (guix store)
@@ -35,7 +34,6 @@
35 #:use-module ((gnu packages admin) 34 #:use-module ((gnu packages admin)
36 #:select (shadow)) 35 #:select (shadow))
37 #:use-module (gnu packages bash) 36 #:use-module (gnu packages bash)
38 #:use-module (ice-9 match)
39 #:use-module (srfi srfi-1) 37 #:use-module (srfi srfi-1)
40 #:use-module (srfi srfi-26) 38 #:use-module (srfi srfi-26)
41 #:use-module (srfi srfi-34) 39 #:use-module (srfi srfi-34)
@@ -224,46 +222,6 @@ for a colorful Guile experience.\\n\\n\"))))\n"))
224 (rename-file ".nanorc" ".config/nano/nanorc")) 222 (rename-file ".nanorc" ".config/nano/nanorc"))
225 #t)))) 223 #t))))
226 224
227(define (find-duplicates list)
228 "Find duplicate entries in @var{list}.
229Two entries are considered duplicates, if they are @code{equal?} to each other.
230This implementation is made asymptotically faster than @code{delete-duplicates}
231through the internal use of hash tables."
232 (let loop ((list list)
233 ;; We actually modify table in-place, but still allocate it here
234 ;; so that we only need one level of indentation.
235 (table (make-hash-table)))
236 (match list
237 (()
238 (hash-fold (lambda (key value seed)
239 (if (> value 1)
240 (cons key seed)
241 seed))
242 '()
243 table))
244 ((first . rest)
245 (hash-set! table first
246 (1+ (hash-ref table first 0)))
247 (loop rest table)))))
248
249(define (assert-unique-account-names users)
250 (match (find-duplicates (map user-account-name users))
251 (() *unspecified*)
252 (duplicates
253 (raise
254 (formatted-message
255 (G_ "the following accounts appear more than once:~{ ~a~}")
256 duplicates)))))
257
258(define (assert-unique-group-names groups)
259 (match (find-duplicates (map user-group-name groups))
260 (() *unspecified*)
261 (duplicates
262 (raise
263 (formatted-message
264 (G_ "the following groups appear more than once:~{ ~a~}")
265 duplicates)))))
266
267(define (assert-valid-users/groups users groups) 225(define (assert-valid-users/groups users groups)
268 "Raise an error if USERS refer to groups not listed in GROUPS." 226 "Raise an error if USERS refer to groups not listed in GROUPS."
269 (let ((groups (list->set (map user-group-name groups)))) 227 (let ((groups (list->set (map user-group-name groups))))
@@ -334,8 +292,6 @@ group."
334 (define group-specs 292 (define group-specs
335 (map user-group->gexp groups)) 293 (map user-group->gexp groups))
336 294
337 (assert-unique-account-names accounts)
338 (assert-unique-group-names groups)
339 (assert-valid-users/groups accounts groups) 295 (assert-valid-users/groups accounts groups)
340 296
341 ;; Add users and user groups. 297 ;; Add users and user groups.