From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp0.migadu.com ([2001:41d0:403:4876::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms13.migadu.com with LMTPS id mOeAE05kpmZLmgAAqHPOHw:P1 (envelope-from ) for ; Sun, 28 Jul 2024 15:31:26 +0000 Received: from aspmx1.migadu.com ([2001:41d0:403:4876::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp0.migadu.com with LMTPS id mOeAE05kpmZLmgAAqHPOHw (envelope-from ) for ; Sun, 28 Jul 2024 17:31:26 +0200 X-Envelope-To: larch@yhetil.org Authentication-Results: aspmx1.migadu.com; dkim=fail ("body hash did not verify") header.d=debbugs.gnu.org header.s=debbugs-gnu-org header.b=ObVyywZf; dkim=fail ("body hash did not verify") header.d=autistici.org header.s=stigmate header.b=uJiMOEd0; spf=pass (aspmx1.migadu.com: domain of "guix-patches-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-patches-bounces+larch=yhetil.org@gnu.org"; dmarc=pass (policy=none) header.from=gnu.org ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1722180686; h=from:from:sender:sender:reply-to:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding:resent-cc: resent-from:resent-sender:resent-message-id:in-reply-to:in-reply-to: references:references:list-id:list-help:list-unsubscribe: list-subscribe:list-post:dkim-signature; bh=/dDzpN+Wf+2euvuNaquHPS8y0C2mQjO7aB4JcOehbGg=; b=dHXoYBp7GxrWy+3hJYUSCgg5ACnUOZSXHinEDIH/NowPGdYP0tAjoC7B1kT938D3BMZFLg PgZPB9XIja+vwo9RzSQHivL6sE0tNUIe8DAIaloCTEn5fANI6UUYSPyyUOJg6qNwI6LWJA x7iPYBJUg0QgzmRhdwuFHxBLGepTCHYcp1PUcXwZ2ZbOdSRklrop3+dOmXIf+ZvLU/vtHM lGCVU+6P/wHUOwk9Dj2Ms2go/GueaEtUQCD0iYvDesuHeSTr2guXNH5JVQrH0NzP2fGSBD kD+CBohQn9j/bmtP1AUGnuvuZeZqItnp0jFjNvu6YBykguxeg++35t1sk69TFA== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=fail ("body hash did not verify") header.d=debbugs.gnu.org header.s=debbugs-gnu-org header.b=ObVyywZf; dkim=fail ("body hash did not verify") header.d=autistici.org header.s=stigmate header.b=uJiMOEd0; spf=pass (aspmx1.migadu.com: domain of "guix-patches-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-patches-bounces+larch=yhetil.org@gnu.org"; dmarc=pass (policy=none) header.from=gnu.org ARC-Seal: i=1; s=key1; d=yhetil.org; t=1722180686; a=rsa-sha256; cv=none; b=THrgndPe1tIoiys0rvfZ0+dVeyBNNC0GfNckVcSkaNF2OqSuI3V8QeQTfj457VSTDZvodU gMJvJnRTJjTXqDFr0G8BR2q0qrOvCHphAKb5eNru87uzXKqpcAkQYpUvBVBH43Pz6PpzFC 3YDSFmY3LmAUyPhGkhnmus6g73qxbn7JMeHEuSrL9MlgDIRtk9roJ4INhHYvqYzwsGTHLg l6bBIs+6KuaXYbJ10ck9hoznXrjxAi3pkRJxMMh9GuYdOCf6iivT8B8LNSb2H6ZtXhLA/3 KfIiySm4XxmvftilDMQR5hlrgN4Q7tVEkOsmTtTjAmyQg9f5ETYEW0kp9IOGXQ== Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id DE8C4211C1 for ; Sun, 28 Jul 2024 17:31:25 +0200 (CEST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1sY5rI-0002ZB-BP; Sun, 28 Jul 2024 11:30:52 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1sY5rH-0002Ys-4L for guix-patches@gnu.org; Sun, 28 Jul 2024 11:30:51 -0400 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1sY5rG-0006Kc-Rq for guix-patches@gnu.org; Sun, 28 Jul 2024 11:30:50 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=debbugs.gnu.org; s=debbugs-gnu-org; h=MIME-Version:References:In-Reply-To:Date:From:To:Subject; bh=fnoegWIFjnuS7mQqES8XFN0q6+mWfKZDt6xrwN84Cvc=; b=ObVyywZfct86gVIQuG1s8NTQ1ajRH0n+P69/mwsp1UiWY0bTqzKKxy2BLoWhF/oa1SHfEg11E1Ub1m5FP+CtVjoz1tzk038BedUH01JmkPbN+1wTzlolLkTVLpiAj/ozVmYDrHclLPtVKIhx4Hr3BkRRLyy4gkLMo9Yn9XRWJbs28cnoZgV0Gvj9B2yz9SqTJv/hRa6kxX+Ed8L9VDJJSohBghe4R+rFnB3YAfNBLh6QNl+ih/KrpIbTWo86CMmDrcjtf8oFZrOvTG7vqPO1SUZqGaPTct/AwIT1UgpBdRmXAF8/eO0phleNIMA6k1ZpUq23Sq+bm0prqZs1472EAg==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1sY5rS-00042a-AX for guix-patches@gnu.org; Sun, 28 Jul 2024 11:31:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#72337] [PATCH 2/3] account: Add /etc/subid and /etc/subgid allocation logic. Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 28 Jul 2024 15:31:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 72337 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 72337@debbugs.gnu.org Cc: Giacomo Leidi Received: via spool by 72337-submit@debbugs.gnu.org id=B72337.172218061915444 (code B ref 72337); Sun, 28 Jul 2024 15:31:02 +0000 Received: (at 72337) by debbugs.gnu.org; 28 Jul 2024 15:30:19 +0000 Received: from localhost ([127.0.0.1]:44235 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1sY5qk-000411-8t for submit@debbugs.gnu.org; Sun, 28 Jul 2024 11:30:19 -0400 Received: from confino.investici.org ([93.190.126.19]:20453) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1sY5qi-00040s-HS for 72337@debbugs.gnu.org; Sun, 28 Jul 2024 11:30:17 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1722180604; bh=fnoegWIFjnuS7mQqES8XFN0q6+mWfKZDt6xrwN84Cvc=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=uJiMOEd00zp1980vrbka1lfB0a7dVZKwve7Un3yb3jXbjoqoVt23LDEgJTqhg4Fmj TTSqSdhdaQxOvFbV0ZYobbsG17OEYIbIlUgJhn5EizVJIE85WUz2WuBdJD2DwiVodU L/Kix0rbqZ5iHkHB/MBojBuA0/doF5oElyq+FM8w= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4WX55m11TFz112j; Sun, 28 Jul 2024 15:30:04 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4WX55m0BsFz112f; Sun, 28 Jul 2024 15:30:03 +0000 (UTC) Date: Sun, 28 Jul 2024 17:29:25 +0200 Message-ID: <56cc1f5f7544fe85aeedab1afc05b2f8ea33a7d6.1722180566.git.goodoldpaul@autistici.org> X-Mailer: git-send-email 2.45.2 In-Reply-To: <1901209e4998ad29192b6f73b1e2828bc5d6f90e.1722180566.git.goodoldpaul@autistici.org> References: <1901209e4998ad29192b6f73b1e2828bc5d6f90e.1722180566.git.goodoldpaul@autistici.org> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Reply-to: Giacomo Leidi X-ACL-Warn: , Giacomo Leidi via Guix-patches From: Giacomo Leidi via Guix-patches via Errors-To: guix-patches-bounces+larch=yhetil.org@gnu.org Sender: guix-patches-bounces+larch=yhetil.org@gnu.org X-Migadu-Country: US X-Migadu-Flow: FLOW_IN X-Spam-Score: -6.52 X-Migadu-Queue-Id: DE8C4211C1 X-Migadu-Scanner: mx10.migadu.com X-Migadu-Spam-Score: -6.52 X-TUID: 4mf5k2lLNpCP * gnu/build/accounts.scm (list-set): New variable; (%sub-id-min): new variable; (%sub-id-max): new variable; (%sub-id-count): new variable; (sub-id?): new variable; (subid-range-fits?): new variable; (subid-range-fits-between?): new variable; (insert-subid-range): new variable; (reserve-subids): new variable; (range->entry): new variable; (entry->range): new variable; (allocate-subids): new variable; (subuid+subgid-databases): new variable. * gnu/system/accounts.scm (subid-range-end): New variable; (subid-range-has-start?): new variable; (subid-range-less): new variable. * test/accounts.scm: Test them. Change-Id: I8de1fd7cfe508b9c76408064d6f498471da0752d --- gnu/build/accounts.scm | 229 +++++++++++++++++++++++++++++++++++++++- gnu/system/accounts.scm | 30 ++++++ tests/accounts.scm | 108 +++++++++++++++++++ 3 files changed, 366 insertions(+), 1 deletion(-) diff --git a/gnu/build/accounts.scm b/gnu/build/accounts.scm index ea8c69f205..3cbbacfaee 100644 --- a/gnu/build/accounts.scm +++ b/gnu/build/accounts.scm @@ -74,8 +74,12 @@ (define-module (gnu build accounts) %id-max %system-id-min %system-id-max + %sub-id-min + %sub-id-max + %sub-id-count - user+group-databases)) + user+group-databases + subuid+subgid-databases)) ;;; Commentary: ;;; @@ -91,6 +95,18 @@ (define-module (gnu build accounts) ;;; ;;; Code: + +;;; +;;; General utilities. +;;; + +(define (list-set lst el k) + (if (>= k (length lst)) + `(,@lst ,el) + `(,@(list-head lst k) + ,el + ,@(list-tail lst k)))) + ;;; ;;; Machinery to define user and group databases. @@ -342,6 +358,12 @@ (define %id-max 60000) (define %system-id-min 100) (define %system-id-max 999) +;; According to Shadow's libmisc/find_new_sub_uids.c and +;; libmisc/find_new_sub_gids.c. +(define %sub-id-min 100000) +(define %sub-id-max 600100000) +(define %sub-id-count 65536) + (define (system-id? id) (and (> id %system-id-min) (<= id %system-id-max))) @@ -350,6 +372,10 @@ (define (user-id? id) (and (>= id %id-min) (< id %id-max))) +(define (sub-id? id) + (and (>= id %sub-id-min) + (< id %sub-id-max))) + (define* (allocate-id assignment #:key system?) "Return two values: a newly allocated ID, and an updated record based on ASSIGNMENT. If SYSTEM? is true, return a system ID." @@ -405,6 +431,156 @@ (define* (reserve-ids allocation ids #:key (skip? #t)) (allocation-ids allocation) ids)))) +(define (subid-range-fits? r interval-start interval-end) + (and (<= interval-start + (subid-range-start r)) + (<= (subid-range-end r) + interval-end))) + +(define (subid-range-fits-between? r a b) + (subid-range-fits? r + (+ (subid-range-start a) 1) + (- (subid-range-end b) 1))) + +(define (insert-subid-range range lst) + (define* (actualize r #:key (start %sub-id-min)) + (if (subid-range-has-start? r) + r + (subid-range + (inherit r) + (start start)))) + (define lst-length (length lst)) + (define range-name (subid-range-name range)) + (define range-start (subid-range-start range)) + (define has-start? (subid-range-has-start? range)) + (define range-end (subid-range-end range)) + + (when has-start? + (unless (and (sub-id? range-start) + (sub-id? range-end)) + (raise + (string-append "Subid range of " range-name + " from " range-start " to " range-end + " spans over illegal subids. Max allowed is " + %sub-id-max ", min is " %sub-id-min ".")))) + + (if (<= lst-length 1) + (if (= lst-length 0) + (list (actualize range)) + (if (subid-range-less range (first lst)) + (list-set lst (actualize range) 0) + (list-set lst + (actualize + range + #:start (and (subid-range-has-start? (first lst)) + (+ (subid-range-end (first lst)) 1))) + 1))) + (let loop ((i 0)) + (define next-i (+ i 1)) + (define ith-range + (list-ref lst i)) + (define ith-start + (subid-range-start ith-range)) + (define ith-has-start? + (subid-range-has-start? ith-range)) + (define ith-name + (subid-range-name ith-range)) + + (if (and + (= next-i lst-length) + (subid-range-less ith-range range)) + (let ((actual-range + (actualize + range + #:start (and ith-has-start? + (+ (subid-range-end ith-range) 1))))) + (list-set lst + actual-range + lst-length)) + (let* ((next-range + (list-ref lst next-i)) + (next-has-start? + (subid-range-has-start? next-range))) + (cond + + ((and has-start? (= range-start ith-start)) + (raise + (string-append "Subid range of " range-name + " has same start " + (number->string range-start) + " of the one " + "from " ith-name "."))) + + ((and (= i 0) + (subid-range-less range ith-range) + (or + (and + has-start? ith-has-start? + (subid-range-fits? (actualize range) + %sub-id-min + (- (subid-range-start + (actualize ith-range)) + 1))) + (not (and has-start? ith-has-start?)))) + (list-set lst (actualize range) 0)) + + ((subid-range-less range ith-range) + (raise + (string-append "Subid range of " range-name + " overlaps with the one of " + ith-name "."))) + + ((and (subid-range-less ith-range range) + (subid-range-less range next-range)) + (if (or (not (and has-start? + ith-has-start? + next-has-start?)) + + (and has-start? + ith-has-start? + next-has-start? + (subid-range-fits-between? range + ith-range + next-range))) + (list-set lst + (actualize range + #:start (and ith-has-start? + (+ (subid-range-end ith-range) 1))) + next-i) + (if (>= i lst-length) + (if (and (subid-range-less next-range range) + (let ((actual-next + (actualize next-range + #:start (and ith-has-start? + (+ (subid-range-end ith-range) 1))))) + (or (not (subid-range-has-start? actual-next)) + (subid-range-fits? + (actualize range + #:start (and next-has-start? + (+ (subid-range-end next-range) 1))) + (+ (subid-range-end actual-next) 1) + %sub-id-max)))) + (list-set lst range lst-length) + (raise + (string-append "Couldn't fit " range-name ", reached end of list."))) + (loop next-i)))) + + ((or + (not has-start?) + (subid-range-less next-range range)) + (loop next-i)) + + (else + (raise (string-append "Couldn't fit " range-name ", this should never happen."))))))))) + +(define* (reserve-subids allocation ranges) + "Mark the subid ranges listed in RANGES as reserved in ALLOCATION. +ALLOCATION is supposed to be sorted by SUBID-RANGE-LESS." + (fold insert-subid-range + allocation + (sort-list ranges + subid-range-less))) + (define (allocated? allocation id) "Return true if ID is already allocated as part of ALLOCATION." (->bool (vhash-assv id (allocation-ids allocation)))) @@ -540,6 +716,31 @@ (define* (allocate-passwd users groups #:optional (current-passwd '())) uids users))) +(define (range->entry range) + (subid-entry + (name (subid-range-name range)) + (start (subid-range-start range)) + (count (subid-range-count range)))) + +(define (entry->range entry) + (subid-range + (name (subid-entry-name entry)) + (start (subid-entry-start entry)) + (count (subid-entry-count entry)))) + +(define* (allocate-subids ranges #:optional (current-ranges '())) + "Return a list of subids entries for RANGES, a list of . Members +for each group are taken from MEMBERS, a vhash that maps ranges names to member +names. IDs found in CURRENT-RANGES, a list of subid entries, are reused." + (define subids + ;; Mark all the currently used IDs and the explicitly requested IDs as + ;; reserved. + (reserve-subids (reserve-subids (list) + current-ranges) + ranges)) + + (map range->entry subids)) + (define* (days-since-epoch #:optional (current-time current-time)) "Return the number of days elapsed since the 1st of January, 1970." (let* ((now (current-time time-utc)) @@ -615,3 +816,29 @@ (define* (user+group-databases users groups #:current-time current-time)) (values group-entries passwd-entries shadow-entries)) + +(define* (subuid+subgid-databases subuids subgids + #:key + (current-subuids + (map entry->range + (empty-if-not-found read-subuid))) + (current-subgids + (map entry->range + (empty-if-not-found read-subgid)))) + "Return two values: the list of subgid entries, and the list of subuid entries +corresponding to SUBUIDS and SUBGIDS. +Preserve stateful bits from CURRENT-SUBUIDS and CURRENT-SUBGIDS." + + (define (range-eqv? a b) + (string=? (subid-range-name a) + (subid-range-name b))) + + (define subuid-entries + (allocate-subids + (lset-difference range-eqv? subuids current-subuids) current-subuids)) + + (define subgid-entries + (allocate-subids + (lset-difference range-eqv? subgids current-subgids) current-subgids)) + + (values subuid-entries subgid-entries)) diff --git a/gnu/system/accounts.scm b/gnu/system/accounts.scm index 9a006c188d..1b88ca301f 100644 --- a/gnu/system/accounts.scm +++ b/gnu/system/accounts.scm @@ -45,6 +45,9 @@ (define-module (gnu system accounts) subid-range-name subid-range-start subid-range-count + subid-range-end + subid-range-has-start? + subid-range-less sexp->user-account sexp->user-group @@ -102,6 +105,33 @@ (define-record-type* ; find_new_sub_uids.c (default 65536))) +(define (subid-range-end range) + "Returns the last subid referenced in RANGE." + (and + (subid-range-has-start? range) + (+ (subid-range-start range) + (subid-range-count range) + -1))) + +(define (subid-range-has-start? range) + "Returns #t when RANGE's start is a number." + (number? (subid-range-start range))) + +(define (subid-range-less a b) + "Returns #t when subid range A either starts before, or is more specific +than B. When it is not possible to determine whether a range is more specific +w.r.t. another range their names are compared alphabetically." + (define start-a (subid-range-start a)) + (define start-b (subid-range-start b)) + (cond ((and (not start-a) (not start-b)) + (string< (subid-range-name a) + (subid-range-name b))) + ((and start-a start-b) + (< start-a start-b)) + (else + (and start-a + (not start-b))))) + (define (default-home-directory account) "Return the default home directory for ACCOUNT." (string-append "/home/" (user-account-name account))) diff --git a/tests/accounts.scm b/tests/accounts.scm index 4944c22f49..2fbebfaf56 100644 --- a/tests/accounts.scm +++ b/tests/accounts.scm @@ -193,6 +193,7 @@ (define %subgid-sample (define allocate-groups (@@ (gnu build accounts) allocate-groups)) (define allocate-passwd (@@ (gnu build accounts) allocate-passwd)) +(define allocate-subids (@@ (gnu build accounts) allocate-subids)) (test-equal "allocate-groups" ;; Allocate GIDs in a stateless fashion. @@ -257,6 +258,69 @@ (define allocate-passwd (@@ (gnu build accounts) allocate-passwd)) (list (group-entry (name "d") (gid (- %id-max 2)))))) +(test-equal "allocate-subids" + ;; Allocate sub IDs in a stateless fashion. + (list (subid-entry (name "root") (start %sub-id-min) (count 100)) + (subid-entry (name "t") (start 100100) (count 899)) + (subid-entry (name "x") (start 100999) (count 200))) + (allocate-subids (list + (subid-range (name "x") (count 200)) + (subid-range (name "t") (count 899))) + (list (subid-range (name "root") (count 100))))) + +(test-equal "allocate-subids with requested IDs ranges" + ;; Make sure the requested sub ID for "t" and "x" are honored. + (list (subid-entry (name "x") (start %sub-id-min) (count 200)) + (subid-entry (name "t") (start 1000000) (count 899)) + (subid-entry (name "l") (start 1000899) (count 100)) + (subid-entry (name "root") (start 1000999) (count 100))) + (allocate-subids (list + (subid-range (name "root") (count 100)) + (subid-range (name "l") (count 100))) + (list + (subid-range (name "x") (start %sub-id-min) (count 200)) + (subid-range (name "t") (start 1000000) (count 899))))) + +(test-equal "allocate-subids with interleaving" + ;; Make sure the requested sub ID for "m" is honored. + (list (subid-entry (name "x") (start %sub-id-min) (count 200)) + (subid-entry (name "t") (start 1000000) (count 899)) + (subid-entry (name "i") (start 1100000) (count 1)) + (subid-entry (name "root") (start 1100001) (count 100)) + (subid-entry (name "m") (start 1200000) (count 27))) + (allocate-subids (list (subid-range (name "m") (start 1200000) (count 27))) + (list + (subid-range (name "x") (start %sub-id-min) (count 200)) + (subid-range (name "t") (start 1000000) (count 899)) + (subid-range (name "i") (start 1100000) (count 1)) + (subid-range (name "root") (count 100))))) + +(let ((inputs+currents + (list + ;; Try impossible before + (list + (list (subid-range (name "m") (start 100100) (count 27))) + (list + (subid-range (name "x") (start %sub-id-min) (count 150)))) + ;; Try impossible after + (list + (list (subid-range (name "m") (start %sub-id-min) (count 30))) + (list + (subid-range (name "x") (start (+ 29 %sub-id-min)) (count 150)))) + ;; Try impossible between + (list + (list (subid-range (name "m") (start 100200) (count 500))) + (list + (subid-range (name "root") (start %sub-id-min) (count 100)) + (subid-range (name "x") (start (+ %sub-id-min 500)) (count 100))))))) + (test-error "allocate-subids with interleaving, impossible interleaving" + "error" + ;; Make sure it's impossible to explicitly request impossible allocations + (for-each + (lambda (lst) + (allocate-subids (first lst) (second lst))) + inputs+currents))) + (test-equal "allocate-passwd" ;; Allocate UIDs in a stateless fashion. (list (password-entry (name "alice") (uid %id-min) (gid 1000) @@ -376,4 +440,48 @@ (define allocate-passwd (@@ (gnu build accounts) allocate-passwd)) (make-time type 0 (* 24 3600 100))))) list)) +(test-equal "subuid+subgid-databases" + ;; The whole process. + (list (list (subid-entry (name "root") + (start %sub-id-min) + (count 100)) + (subid-entry (name "alice") + (start (+ %sub-id-min 100)) + (count 200)) + (subid-entry (name "bob") + (start (+ %sub-id-min 100 200)) + (count 200))) + (list + (subid-entry (name "root") + (start %sub-id-min) + (count 200)) + (subid-entry (name "alice") + (start (+ %sub-id-min 200)) + (count 400)) + (subid-entry (name "charlie") + (start (+ %sub-id-min 200 400)) + (count 300)))) + (call-with-values + (lambda () + (subuid+subgid-databases + (list (subid-range (name "root") + (start %sub-id-min) + (count 100)) + (subid-range (name "alice") + (start (+ %sub-id-min 100)) + (count 200)) + (subid-range (name "bob") + (count 200))) + (list + (subid-range (name "alice") + (count 400)) + (subid-range (name "charlie") + (count 300))) + #:current-subgids + (list (subid-range (name "root") + (start %sub-id-min) + (count 200))) + #:current-subuids '())) + list)) + (test-end "accounts") -- 2.45.2