diff --git a/gnu/build/accounts.scm b/gnu/build/accounts.scm index 74f49ff9b49..5438d59593f 100644 --- a/gnu/build/accounts.scm +++ b/gnu/build/accounts.scm @@ -359,7 +359,7 @@ to it atomically and set the appropriate permissions." (left unused-subid-range-left ;previous unused subuid range or #f (default #f)) (min unused-subid-range-min ;lower bound of this unused subuid range - (default %subordinate-id-min)) + (default 0)) (max unused-subid-range-max ;upper bound (default %subordinate-id-max)) (right unused-subid-range-right ;next unused subuid range or #f @@ -555,7 +555,10 @@ will be marked as used in it." (define actual-range (subid-range (inherit range) - (start allocation-start))) + ;; New IDs are only allocated between %subordinate-id-min and + ;; %subordinate-id-max. + (start + (max allocation-start %subordinate-id-min)))) (if (within-interval? allocation actual-range) (values @@ -603,13 +606,6 @@ is visited to find the best unused range that can hold RANGE." (define range-end (subid-range-end range)) - (unless (and (subordinate-id? range-start) - (subordinate-id? range-end)) - (raise - (condition - (&invalid-subid-range-error - (range range))))) - (define less? (< range-end allocation-start)) (define more? @@ -802,12 +798,23 @@ new UIDs." (define* (allocate-subids ranges #:optional (current-ranges '())) "Return a list of subids entries for RANGES, a list of . IDs found in CURRENT-RANGES, a list of subid entries, are reused." + ;; Ranges from disk must always have a start. (let ((generic (any (compose not subid-range-has-start?) current-ranges))) (when generic (raise (condition (&specific-subid-range-expected-error (range generic)))))) + (for-each + (lambda (range) + ;; New ranges must always be included in the current supported set. + (unless (or (not (subid-range-has-start? range)) + (and (subordinate-id? (subid-range-start range)) + (subordinate-id? (subid-range-end range)))) + (raise + (condition (&invalid-subid-range-error (range range)))))) + ranges) + (define sorted-ranges (stable-sort ranges subid-range-less)) diff --git a/tests/accounts.scm b/tests/accounts.scm index 41ed706e9ed..60a8f4bf66d 100644 --- a/tests/accounts.scm +++ b/tests/accounts.scm @@ -271,6 +271,23 @@ ada:100600:300\n") (start %subordinate-id-min) (count 100))))) +(test-equal "allocate-subids with externally managed state" + (list (subid-entry (name "guix-daemon") (start 904) (count 1)) + (subid-entry (name "alice") (start 1085) (count 100)) + (subid-entry (name "t") (start %subordinate-id-min) (count 899)) + (subid-entry (name "x") (start 100899) (count 200))) + (allocate-subids (list + (subid-range (name "x") (count 200)) + (subid-range (name "t") (count 899))) + ;; Test use case from + ;; https://codeberg.org/guix/guix/issues/3925 + (list (subid-range (name "guix-daemon") + (start 904) + (count 1)) + (subid-range (name "alice") + (start 1085) + (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))