From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp1.migadu.com ([2001:41d0:303:e224::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms13.migadu.com with LMTPS id WHyvMEa93GbBOQAA62LTzQ:P1 (envelope-from ) for ; Sat, 07 Sep 2024 20:53:26 +0000 Received: from aspmx1.migadu.com ([2001:41d0:303:e224::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp1.migadu.com with LMTPS id WHyvMEa93GbBOQAA62LTzQ (envelope-from ) for ; Sat, 07 Sep 2024 22:53: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="JoB8t/nq"; dkim=fail ("body hash did not verify") header.d=autistici.org header.s=stigmate header.b=JnjCWpBp; dmarc=pass (policy=none) header.from=gnu.org; 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" ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1725742406; 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=jvaWOcG+QQppNCxmVPURfIe0K9LxkBFK8lYc6oKkAEU=; b=KL3nAN9VFHFJ2npbnOS/SeLoCkK5dtlRma8IC0UDLtJQIWDWK8FFeZIGtOMNen4iMu86jL m2O1N1EOpGtPeP3CzUes6camZKH3e4v6Mxl5q6pQx50zjQM0SGKSfFwg3oc4ZLJxyH2L1g SBhOxDFmqljZq256rfXSpejyUiZl8pTwQn03svUG4dyYFX9Xu6FcNHmcMugTA8ddgoG+p9 erxJlsbUIJOAdqkh0bWa0NsrW5YNVXfyArpJCzxRKZ090NNsy81L8LRR1OxA40oWE9eeUp OaIAtV3ykdef+nKVg00mjyt5lFgWXkwZvyA7shHPkehiUZgq6TKVVkRgkLwaUg== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1725742406; a=rsa-sha256; cv=none; b=sxwfiu/sc3yZZHFnwwqiEUKxOVLdiCPyHlsrvn9BcENzC2H2aLMdMsBhEeKN+Pa1fXRIMh dt9+DXIcPVl1DA0SfB036tlWsJt+zGz1GMtD0BJ+XaJKwBFT90kV2oF4ND44uliUFp7qE6 uFz1+2xPSZZuUGYP2REkfXqOA+x1X7sjs2X8IwmdIitHxKhYuod0vt/cNn794RxMHFlOsS q6poHohZgnEk13mYDGsIS3m9VLR1J7rlD3ptszR5O+mjnJ9fE/A+YrbrU69A/vuHRteupO P6p45wah3zRMCN8b6F9ku9jzPNfjEOFRGHuyZPbVIZPdDGf7U9ivQWj6scPzAg== 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="JoB8t/nq"; dkim=fail ("body hash did not verify") header.d=autistici.org header.s=stigmate header.b=JnjCWpBp; dmarc=pass (policy=none) header.from=gnu.org; 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" 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 309B7861A9 for ; Sat, 7 Sep 2024 22:53:26 +0200 (CEST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1sn2QZ-0004cH-Ky; Sat, 07 Sep 2024 16:53:03 -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 1sn2QX-0004bm-VP for guix-patches@gnu.org; Sat, 07 Sep 2024 16:53:01 -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 1sn2QX-0001wY-MH for guix-patches@gnu.org; Sat, 07 Sep 2024 16:53:01 -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=6ugOMZGSXDJjz+6Ma9hN3Meqh+YRJ4sYm4AGwbmHS1M=; b=JoB8t/nqGODm6DlrCyLg2gd0KKbN9YdFAkszMnlSj59HRR5VB0WaeFpVK32z9dABgQbp4oEJKE1Bmp50bG3z+IKthd040pJrAEQB67kCvC8ctU3urErc3FnvYHk7+9oCyKvVU15k6fMnKKWUrfBmAew5QzjChcuInFOCDlrwzHuWadXOk748abat1xUJt6XJo3lg3X11CF4WPNA8TLVNQPqFkVWx1cRK87HOE4QECLxmW/NHkrGR5C7bPvcZZnFOSrEUa0+yBjB9U8UDvbLz2lM/B78YkXObpl5s3L+f+xDTFMqDMermnHiSbf0k3hnKgaEXRD+ToR3xYv8vTKFgJg==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1sn2QY-0003gP-Sg for guix-patches@gnu.org; Sat, 07 Sep 2024 16:53:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#72337] [PATCH v4 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: Sat, 07 Sep 2024 20:53: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.172574232814055 (code B ref 72337); Sat, 07 Sep 2024 20:53:02 +0000 Received: (at 72337) by debbugs.gnu.org; 7 Sep 2024 20:52:08 +0000 Received: from localhost ([127.0.0.1]:57681 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1sn2Pf-0003eX-EP for submit@debbugs.gnu.org; Sat, 07 Sep 2024 16:52:08 -0400 Received: from confino.investici.org ([93.190.126.19]:59135) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1sn2Pc-0003eH-T4 for 72337@debbugs.gnu.org; Sat, 07 Sep 2024 16:52:06 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1725742323; bh=6ugOMZGSXDJjz+6Ma9hN3Meqh+YRJ4sYm4AGwbmHS1M=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=JnjCWpBpsWbUHM2CLpazc1MTA+GpfIrHno7cwLmht7m+mwZnxT09nr1PwnUc/G4/Q Bq9vkt+zIgpoUxwc10yHxmCGzwGYugiNTiw3SOnnJ2eoLkc2IeP5sE2Mo+EqTty2rb l8Vik/YCj3MWuiyMyS/c3yuVgUPNQUwfxgaAxFMY= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4X1QJM0vxVz11Fl; Sat, 7 Sep 2024 20:52:03 +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 4X1QJM04ctz11FW; Sat, 7 Sep 2024 20:52:02 +0000 (UTC) Date: Sat, 7 Sep 2024 22:51:48 +0200 Message-ID: <2771695a2527240c89c0ba6879aeda0d4ab840ab.1725742309.git.goodoldpaul@autistici.org> X-Mailer: git-send-email 2.45.2 In-Reply-To: <8737329a065c5436643c6e5e7d52ec760f069725.1725742309.git.goodoldpaul@autistici.org> References: <8737329a065c5436643c6e5e7d52ec760f069725.1725742309.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-Flow: FLOW_IN X-Migadu-Country: US X-Migadu-Queue-Id: 309B7861A9 X-Migadu-Scanner: mx12.migadu.com X-Migadu-Spam-Score: -6.59 X-Spam-Score: -6.59 X-TUID: uo42rHHFAQWk This commit adds allocation logic for subid ranges. Subid ranges are ranges of contiguous subids that are mapped to a user in the host system. This patch implements a flexible allocation algorithm allowing users that do not want (or need) to specify details of the subid ranges that they are requesting to avoid doing so, while upholding requests of users that need to have specific ranges. * gnu/build/accounts.scm (list-set): New variable; (%subordinate-id-min): new variable; (%subordinate-id-max): new variable; (%subordinate-id-count): new variable; (subordinate-id?): new variable; (within-interval?): 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 Signed-off-by: Giacomo Leidi --- gnu/build/accounts.scm | 187 +++++++++++++++++++++++++++++++++++++++- gnu/system/accounts.scm | 30 +++++++ tests/accounts.scm | 152 ++++++++++++++++++++++++++++++++ 3 files changed, 368 insertions(+), 1 deletion(-) diff --git a/gnu/build/accounts.scm b/gnu/build/accounts.scm index ea8c69f205..be981fca38 100644 --- a/gnu/build/accounts.scm +++ b/gnu/build/accounts.scm @@ -25,6 +25,8 @@ (define-module (gnu build accounts) #:use-module (srfi srfi-11) #:use-module (srfi srfi-19) #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) #:use-module (ice-9 match) #:use-module (ice-9 vlist) #:use-module (ice-9 rdelim) @@ -74,8 +76,19 @@ (define-module (gnu build accounts) %id-max %system-id-min %system-id-max + %subordinate-id-min + %subordinate-id-max + %subordinate-id-count - user+group-databases)) + &subordinate-id-error + subordinate-id-error? + &subordinate-id-range-error + subordinate-id-range-error? + subordinate-id-range-error-message + subordinate-id-range-error-ranges + + user+group-databases + subuid+subgid-databases)) ;;; Commentary: ;;; @@ -91,6 +104,18 @@ (define-module (gnu build accounts) ;;; ;;; Code: + +;;; +;;; General utilities. +;;; + +(define (vlist-set vlst el k) + (if (>= k (vlist-length vlst)) + (vlist-append vlst (vlist-cons el vlist-null)) + (vlist-append + (vlist-take vlst k) + (vlist-cons el (vlist-drop vlst k))))) + ;;; ;;; Machinery to define user and group databases. @@ -342,6 +367,19 @@ (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 %subordinate-id-min 100000) +(define %subordinate-id-max 600100000) +(define %subordinate-id-count 65536) + +(define-condition-type &subordinate-id-error &error + subordinate-id-error?) +(define-condition-type &subordinate-id-range-error &subordinate-id-error + subordinate-id-range-error? + (message subordinate-id-range-error-message) + (ranges subordinate-id-range-error-ranges)) + (define (system-id? id) (and (> id %system-id-min) (<= id %system-id-max))) @@ -350,6 +388,10 @@ (define (user-id? id) (and (>= id %id-min) (< id %id-max))) +(define (subordinate-id? id) + (and (>= id %subordinate-id-min) + (< id %subordinate-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 +447,90 @@ (define* (reserve-ids allocation ids #:key (skip? #t)) (allocation-ids allocation) ids)))) +(define (within-interval? start end range) + "Returns #t when RANGE is included in the interval +bounded by START and END. Both ends of the interval +are included in the comparison." + (unless (subid-range-has-start? range) + (raise + (condition + (&subordinate-id-range-error + (ranges (list range)) + (message + "Subid ranges should have a start to be tested within +an interval."))))) + (and (<= start + (subid-range-start range)) + (<= (subid-range-end range) + end))) + +(define (insert-subid-range range vlst) + "Allocates a range of subids in VLST, based on RANGE. Ranges +that do not explicitly specify a start subid are fitted based on +their size. This procedure assumes VLIST is sorted by SUBID-RANGE-LESS and +that all VLST members have a start." + (define* (actualize r #:key (start %subordinate-id-min)) + (if (subid-range-has-start? r) + r + (subid-range + (inherit r) + (start start)))) + + (define vlst-length (vlist-length vlst)) + (define range-name (subid-range-name range)) + (define range-start (subid-range-start range)) + (define range-end (subid-range-end range)) + + (when (subid-range-has-start? range) + (unless (and (subordinate-id? range-start) + (subordinate-id? range-end)) + (raise + (condition + (&subordinate-id-range-error + (ranges (list range)) + (message + (string-append "Subid range of " range-name + " from " (number->string range-start) " to " + (number->string range-end) + " spans over illegal subids. Max allowed is " + (number->string %subordinate-id-max) ", min is " + (number->string %subordinate-id-min) "."))))))) + + (let loop ((i 0) + (start %subordinate-id-min) + (end (if (< vlst-length 1) + %subordinate-id-max + (- (subid-range-start + (vlist-ref vlst 0)) + 1)))) + (define actual-range + (actualize range #:start start)) + (cond + ((> i vlst-length) + (raise + (condition + (&subordinate-id-range-error + (ranges (list range)) + (message + (string-append "Couldn't fit " range-name + ", reached end of list.")))))) + ((within-interval? start end actual-range) + (vlist-set vlst actual-range i)) + (else + (loop (+ i 1) + (+ 1 (subid-range-end + (vlist-ref vlst (if (= i vlst-length) (- i 1) i)))) + (if (>= i (- vlst-length 1)) + %subordinate-id-max + (- (subid-range-start + (vlist-ref vlst (+ i 1))) + 1))))))) + +(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." + (vlist-fold insert-subid-range allocation ranges)) + (define (allocated? allocation id) "Return true if ID is already allocated as part of ALLOCATION." (->bool (vhash-assv id (allocation-ids allocation)))) @@ -540,6 +666,39 @@ (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." + (when (any (compose not subid-range-has-start?) current-ranges) + (raise + (condition + (&subordinate-id-range-error + (ranges current-ranges) + (message "Loaded ranges are supposed to have a start, but at least one does not."))))) + (define subids + ;; Mark all the currently used IDs and the explicitly requested IDs as + ;; reserved. + (reserve-subids (reserve-subids vlist-null + (list->vlist current-ranges)) + (list->vlist + (stable-sort ranges + subid-range-less)))) + + (map range->entry (vlist->list 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 +774,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..3d038568df 100644 --- a/tests/accounts.scm +++ b/tests/accounts.scm @@ -21,6 +21,7 @@ (define-module (test-accounts) #:use-module (gnu build accounts) #:use-module (gnu system accounts) #:use-module (srfi srfi-19) + #:use-module (srfi srfi-34) #:use-module (srfi srfi-64) #:use-module (ice-9 vlist) #:use-module (ice-9 match)) @@ -193,6 +194,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 +259,112 @@ (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 %subordinate-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") + (start %subordinate-id-min) + (count 100))))) + +(test-equal "allocate-subids with requested IDs ranges" + ;; Make sure the requested sub ID for "k" and "root" are honored. + (list (subid-entry (name "x") (start %subordinate-id-min) (count 200)) + (subid-entry (name "k") (start (+ %subordinate-id-min 300)) (count 100)) + (subid-entry (name "t") (start (+ %subordinate-id-min 500)) (count 899)) + (subid-entry (name "root") (start (+ %subordinate-id-min 2500)) (count 100))) + + (allocate-subids (list + (subid-range (name "root") (start (+ %subordinate-id-min 2500)) (count 100)) + (subid-range (name "k") (start (+ %subordinate-id-min 300)) (count 100))) + (list + (subid-range (name "x") (start %subordinate-id-min) (count 200)) + (subid-range (name "t") (start (+ %subordinate-id-min 500)) (count 899))))) + +(let ((inputs+currents + (list + (list + "ranges must have start" + (list (subid-range (name "m"))) + (list (subid-range (name "x"))) + "Loaded ranges are supposed to have a start, but at least one does not.") + (list + "ranges must fall within allowed max min subids" + (list (subid-range (name "m") + (start (- %subordinate-id-min 1)) + (count + (+ %subordinate-id-max %subordinate-id-min)))) + (list + (subid-range (name "root") (start %subordinate-id-min))) + "Subid range of m from 99999 to 600299998 spans over illegal subids. Max allowed is 600100000, min is 100000.")))) + + ;; Make sure it's impossible to explicitly request impossible allocations + (for-each + (match-lambda + ((test-name ranges current-ranges message) + (test-assert (string-append "allocate-subids, impossible allocations - " + test-name) + (guard (c ((and (subordinate-id-range-error? c) + (string=? message (subordinate-id-range-error-message c))) + #t)) + (allocate-subids ranges current-ranges) + #f)))) + inputs+currents)) + +(test-equal "allocate-subids with interleaving" + ;; Make sure the requested sub ID for "m" is honored and + ;; for "l" and "i" are correctly deduced. + (list (subid-entry (name "x") (start %subordinate-id-min) (count 200)) + (subid-entry (name "l") (start (+ %subordinate-id-min 200)) (count 1)) + (subid-entry (name "m") (start (+ %subordinate-id-min 201)) (count 27)) + (subid-entry (name "i") (start (+ %subordinate-id-min 228)) (count 2)) + (subid-entry (name "root") (start (+ %subordinate-id-min 231)) (count 100))) + (allocate-subids (list + (subid-range (name "m") (start (+ %subordinate-id-min 201)) (count 27)) + (subid-range (name "l") (count 1)) + (subid-range (name "i") (count 2))) + (list + (subid-range (name "x") (start %subordinate-id-min) (count 200)) + (subid-range (name "root") (start (+ %subordinate-id-min 231)) (count 100))))) + +(let ((inputs+currents + (list + ;; Try impossible before + (list + (list (subid-range (name "m") (start %subordinate-id-min) (count 16))) + (list + (subid-range (name "x") (start (+ 15 %subordinate-id-min)) (count 150))) + "Couldn't fit m, reached end of list.") + ;; Try impossible after + (list + (list (subid-range (name "m") (start %subordinate-id-min) (count 30))) + (list + (subid-range (name "x") (start (+ 29 %subordinate-id-min)) (count 150))) + "Couldn't fit m, reached end of list.") + ;; Try impossible between + (list + (list (subid-range (name "m") (start 100200) (count 500))) + (list + (subid-range (name "root") (start %subordinate-id-min) (count 100)) + (subid-range (name "x") (start (+ %subordinate-id-min 500)) (count 100))) + "Couldn't fit m, reached end of list.")))) + + ;; Make sure it's impossible to explicitly request impossible allocations + (for-each + (match-lambda + ((ranges current-ranges message) + (test-assert "allocate-subids with interleaving, impossible interleaving" + (guard (c ((and (subordinate-id-range-error? c) + (string=? message (subordinate-id-range-error-message c))) + #t)) + (allocate-subids ranges current-ranges) + #f)))) + inputs+currents)) + (test-equal "allocate-passwd" ;; Allocate UIDs in a stateless fashion. (list (password-entry (name "alice") (uid %id-min) (gid 1000) @@ -376,4 +484,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 %subordinate-id-min) + (count 100)) + (subid-entry (name "alice") + (start (+ %subordinate-id-min 100)) + (count 200)) + (subid-entry (name "bob") + (start (+ %subordinate-id-min 100 200)) + (count 200))) + (list + (subid-entry (name "root") + (start %subordinate-id-min) + (count 200)) + (subid-entry (name "alice") + (start (+ %subordinate-id-min 200)) + (count 400)) + (subid-entry (name "charlie") + (start (+ %subordinate-id-min 200 400)) + (count 300)))) + (call-with-values + (lambda () + (subuid+subgid-databases + (list (subid-range (name "root") + (start %subordinate-id-min) + (count 100)) + (subid-range (name "alice") + (start (+ %subordinate-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 %subordinate-id-min) + (count 200))) + #:current-subuids '())) + list)) + (test-end "accounts") -- 2.45.2