Add /etc/subuid and /etc/subgid support

  • Open
  • quality assurance status badge
Details
2 participants
  • paul
  • Ludovic Courtès
Owner
unassigned
Submitted by
paul
Severity
normal
P
P
paul wrote on 28 Jul 17:25 +0200
(address . guix-patches@gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
f07af6e8-8c73-9193-5f08-29f8ed1720fb@autistici.org
Dear guixers,

I'm sending a small patch set to add a Guix System service (hopefully :)
) able to handle /etc/subuid and /etc/subgid . It should be a first step
towards a structured rootless-podman-service-type that I plan to
implement. Please let me know your thoughts.

Ludo’ : I'm CCing you just FYI , this is not an ask for review just in
some files your name is the only one in the copyright section and it may
be that you are the most familiar with those, but please look at this
when and if you have time.

Thank you everyone for your work,

giacomo
G
G
Giacomo Leidi wrote on 28 Jul 17:29 +0200
[PATCH 2/3] account: Add /etc/subid and /etc/subgid allocation logic.
(address . 72337@debbugs.gnu.org)(name . Giacomo Leidi)(address . goodoldpaul@autistici.org)
56cc1f5f7544fe85aeedab1afc05b2f8ea33a7d6.1722180566.git.goodoldpaul@autistici.org
* 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(-)

Toggle diff (461 lines)
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 <allocation> 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 <subid-range>. 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* <subid-range>
; 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
G
G
Giacomo Leidi wrote on 28 Jul 17:29 +0200
[PATCH 1/3] accounts: Add /etc/subuid and /etc/subgid support.
(address . 72337@debbugs.gnu.org)(name . Giacomo Leidi)(address . goodoldpaul@autistici.org)
1901209e4998ad29192b6f73b1e2828bc5d6f90e.1722180566.git.goodoldpaul@autistici.org
This commit adds a new record type, <subid-entry> and serializers
and deserializers for it in (gnu build accounts). Each instance of this
record represents one line in either /etc/subuid or /etc/subgid. Since
Shadow uses the same representation for both files, it should be ok if
we do it as well.

This commit adds also <subid-range>, a user facing representation of
<subid-entry>. It is supposed to be usable directly in OS configurations.

* gnu/build/accounts.scm (subid-entry): New record;
(write-subgid): add serializer for subgids;
(write-subuid): add serializer for subuids;
(read-subgid): add serializer for subgids;
(read-subuid): add serializer for subuids.
* gnu/system/accounts.scm (subid-range): New record.
* test/accounts.scm: Test them.

Change-Id: I6b037e40e354c069bf556412bb5b626bd3ea1b2c
---
gnu/build/accounts.scm | 37 ++++++++++++++++++++++++---
gnu/system/accounts.scm | 17 +++++++++++++
tests/accounts.scm | 55 +++++++++++++++++++++++++++++++++++++++++
3 files changed, 106 insertions(+), 3 deletions(-)

Toggle diff (215 lines)
diff --git a/gnu/build/accounts.scm b/gnu/build/accounts.scm
index fa6f454b5e..ea8c69f205 100644
--- a/gnu/build/accounts.scm
+++ b/gnu/build/accounts.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019, 2021, 2023 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2024 Giacomo Leidi <goodoldpaul@autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -51,13 +52,23 @@ (define-module (gnu build accounts)
group-entry-gid
group-entry-members
+ subid-entry
+ subid-entry?
+ subid-entry-name
+ subid-entry-start
+ subid-entry-count
+
%password-lock-file
write-group
write-passwd
write-shadow
+ write-subgid
+ write-subuid
read-group
read-passwd
read-shadow
+ read-subgid
+ read-subuid
%id-min
%id-max
@@ -68,11 +79,12 @@ (define-module (gnu build accounts)
;;; Commentary:
;;;
-;;; This modules provides functionality equivalent to the C library's
+;;; This module provides functionality equivalent to the C library's
;;; <shadow.h>, <pwd.h>, and <grp.h> routines, as well as a subset of the
;;; functionality of the Shadow command-line tools. It can parse and write
-;;; /etc/passwd, /etc/shadow, and /etc/group. It can also take care of UID
-;;; and GID allocation in a way similar to what 'useradd' does.
+;;; /etc/passwd, /etc/shadow, /etc/group, /etc/subuid and /etc/subgid. It can
+;;; also take care of UID and GID allocation in a way similar to what 'useradd'
+;;; does. The same goes for sub UID and sub GID allocation.
;;;
;;; The benefit is twofold: less code is involved, and the ID allocation
;;; strategy and state preservation is made explicit.
@@ -225,6 +237,17 @@ (define-database-entry <group-entry> ;<grp.h>
(serialization list->comma-separated comma-separated->list)
(default '())))
+(define-database-entry <subid-entry> ;<subid.h>
+ subid-entry make-subid-entry
+ subid-entry?
+ (serialization #\: subid-entry->string string->subid-entry)
+
+ (name subid-entry-name)
+ (start subid-entry-start
+ (serialization number->string string->number))
+ (count subid-entry-count
+ (serialization number->string string->number)))
+
(define %password-lock-file
;; The password database lock file used by libc's 'lckpwdf'. Users should
;; grab this lock with 'with-file-lock' when they access the databases.
@@ -265,6 +288,10 @@ (define write-shadow
(database-writer "/etc/shadow" #o600 shadow-entry->string))
(define write-group
(database-writer "/etc/group" #o644 group-entry->string))
+(define write-subuid
+ (database-writer "/etc/subuid" #o644 subid-entry->string))
+(define write-subgid
+ (database-writer "/etc/subgid" #o644 subid-entry->string))
(define (database-reader file string->entry)
(lambda* (#:optional (file-or-port file))
@@ -287,6 +314,10 @@ (define read-shadow
(database-reader "/etc/shadow" string->shadow-entry))
(define read-group
(database-reader "/etc/group" string->group-entry))
+(define read-subuid
+ (database-reader "/etc/subuid" string->subid-entry))
+(define read-subgid
+ (database-reader "/etc/subgid" string->subid-entry))
;;;
diff --git a/gnu/system/accounts.scm b/gnu/system/accounts.scm
index 586cff1842..9a006c188d 100644
--- a/gnu/system/accounts.scm
+++ b/gnu/system/accounts.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2024 Giacomo Leidi <goodoldpaul@autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -39,6 +40,12 @@ (define-module (gnu system accounts)
user-group-id
user-group-system?
+ subid-range
+ subid-range?
+ subid-range-name
+ subid-range-start
+ subid-range-count
+
sexp->user-account
sexp->user-group
@@ -85,6 +92,16 @@ (define-record-type* <user-group>
(system? user-group-system? ; Boolean
(default #f)))
+(define-record-type* <subid-range>
+ subid-range make-subid-range
+ subid-range?
+ (name subid-range-name)
+ (start subid-range-start (default #f)) ; number
+ (count subid-range-count ; number
+ ; from find_new_sub_gids.c and
+ ; find_new_sub_uids.c
+ (default 65536)))
+
(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 78136390bb..4944c22f49 100644
--- a/tests/accounts.scm
+++ b/tests/accounts.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2024 Giacomo Leidi <goodoldpaul@autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -41,6 +42,16 @@ (define %shadow-sample
charlie:" (crypt "hey!" "$6$abc") ":17169::::::
nobody:!:0::::::\n"))
+(define %subuid-sample
+ "\
+root:100000:300
+ada:100300:300\n")
+
+(define %subgid-sample
+ "\
+root:100000:600
+ada:100600:300\n")
+
(test-begin "accounts")
@@ -135,6 +146,50 @@ (define %shadow-sample
read-shadow)
port))))
+(test-equal "write-subuid"
+ %subuid-sample
+ (call-with-output-string
+ (lambda (port)
+ (write-subuid (list (subid-entry
+ (name "root")
+ (start 100000)
+ (count 300))
+ (subid-entry
+ (name "ada")
+ (start 100300)
+ (count 300)))
+ port))))
+
+(test-equal "read-subuid + write-subuid"
+ %subuid-sample
+ (call-with-output-string
+ (lambda (port)
+ (write-subuid (call-with-input-string %subuid-sample
+ read-subuid)
+ port))))
+
+(test-equal "write-subgid"
+ %subgid-sample
+ (call-with-output-string
+ (lambda (port)
+ (write-subgid (list (subid-entry
+ (name "root")
+ (start 100000)
+ (count 600))
+ (subid-entry
+ (name "ada")
+ (start 100600)
+ (count 300)))
+ port))))
+
+(test-equal "read-subgid + write-subgid"
+ %subgid-sample
+ (call-with-output-string
+ (lambda (port)
+ (write-subgid (call-with-input-string %subgid-sample
+ read-subgid)
+ port))))
+
(define allocate-groups (@@ (gnu build accounts) allocate-groups))
(define allocate-passwd (@@ (gnu build accounts) allocate-passwd))

base-commit: 8c6e724686ac37ff7955b97d9bfd03176b14d82a
--
2.45.2
G
G
Giacomo Leidi wrote on 28 Jul 17:29 +0200
[PATCH 3/3] system: Add /etc/subuid and /etc/subgid support.
(address . 72337@debbugs.gnu.org)(name . Giacomo Leidi)(address . goodoldpaul@autistici.org)
6b97096800ebf51a666ab2ee93fd2fdec3c2c65c.1722180566.git.goodoldpaul@autistici.org
This commit adds a Guix System service to handle allocation of subuid
and subgid requests. Users that don't care can just add themselves as a
subid-range and don't need to specify anything but their user name.
Users that care about specific ranges, such as possibly LXD, can specify
a start and a count.

* doc/guix.texi: Document the new service.
* gnu/build/activation.scm (activate-subuids+subgids): New variable.
* gnu/local.mk: Add gnu/tests/shadow.scm.
* gnu/system/accounts.scm (sexp->subid-range): New variable.
* gnu/system/shadow.scm (%root-subid): New variable;
(subids-configuration): new record;
(subid-range->gexp): new variable;
(assert-valid-subids): new variable;
(delete-duplicate-ranges): new variable;
(subids-activation): new variable;
(subids-extension): new record;
(append-subid-ranges): new variable;
(subids-extension-merge): new variable;
(subids-service-type): new variable.
* gnu/tests/shadow.scm (subids): New system test.

Change-Id: I3755e1c75771220c74fe8ae5de1a7d90f2376635
---
doc/guix.texi | 171 ++++++++++++++++++++++++++++++++
gnu/build/activation.scm | 19 ++++
gnu/local.mk | 1 +
gnu/system/accounts.scm | 10 ++
gnu/system/shadow.scm | 207 ++++++++++++++++++++++++++++++++++++++-
gnu/tests/shadow.scm | 128 ++++++++++++++++++++++++
6 files changed, 534 insertions(+), 2 deletions(-)
create mode 100644 gnu/tests/shadow.scm

Toggle diff (562 lines)
diff --git a/doc/guix.texi b/doc/guix.texi
index 9ba96af459..d0b2a5284c 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -41582,6 +41582,177 @@ Miscellaneous Services
@end deftp
+@c %end of fragment
+
+@cindex Subids
+@subsubheading Subid Service
+
+The @code{(gnu system shadow)} module exposes the
+@code{subids-service-type}, its configuration record
+@code{subids-configuration} and its extension record
+@code{subids-extension}.
+
+With @code{subids-service-type}, subuids and subgids ranges can be reserved for
+users that desire so:
+
+@lisp
+(use-modules (gnu system shadow) ;for 'subids-service-type'
+ (gnu system accounts) ;for 'subid-range'
+ @dots{})
+
+(operating-system
+ ;; @dots{}
+ (services
+ (list
+ (simple-service 'alice-bob-subids
+ subids-service-type
+ (subids-extension
+ (subgids
+ (list
+ (subid-range (name "alice"))))
+ (subuids
+ (list
+ (subid-range (name "alice"))
+ (subid-range (name "bob")
+ (start 100700)))))))))
+@end lisp
+
+Users (definitely other services), usually, are supposed to extend the service
+instead of adding subids directly to @code{subids-configuration}, unless the
+want to change the default behavior for root. With default settings the
+@code{subids-service-type} adds, if it's not already there, a configuration
+for the root account to both @code{/etc/subuid} and @code{/etc/subgid}, possibly
+starting at the minimum possible subid. Otherwise the root subuids and subgids
+ranges are fitted wherever possible.
+
+The above configuration will yield the following:
+
+@example
+# cat /etc/subgid
+root:100000:65536
+alice:165536:65536
+# cat /etc/subuid
+root:100000:700
+bob:100700:65536
+alice:166236:65536
+@end example
+
+@c %start of fragment
+
+@deftp {Data Type} subids-configuration
+
+With default settings the
+@code{subids-service-type} adds, if it's not already there, a configuration
+for the root account to both @code{/etc/subuid} and @code{/etc/subgid}, possibly
+starting at the minimum possible subid. To disable the default behavior and
+provide your own definition for the root subid ranges you can set to @code{#f}
+the @code{add-root?} field:
+
+@lisp
+(use-modules (gnu system shadow) ;for 'subids-service-type'
+ (gnu system accounts) ;for 'subid-range'
+ @dots{})
+
+(operating-system
+ ;; @dots{}
+ (services
+ (list
+ (service subids-service-type
+ (subids-configuration
+ (add-root? #f)
+ (subgids
+ (subid-range (name "root")
+ (start 120000)
+ (count 100)))
+ (subuids
+ (subid-range (name "root")
+ (start 120000)
+ (count 100)))))
+ (simple-service 'alice-bob-subids
+ subids-service-type
+ (subids-extension
+ (subgids
+ (list
+ (subid-range (name "alice"))))
+ (subuids
+ (list
+ (subid-range (name "alice"))
+ (subid-range (name "bob")
+ (start 100700)))))))))
+@end lisp
+
+Available @code{subids-configuration} fields are:
+
+@table @asis
+@item @code{add-root?} (default: @code{#t}) (type: boolean)
+Whether to automatically configure subuids and subgids for root.
+
+@item @code{subgids} (default: @code{'()}) (type: list-of-subid-ranges)
+The list of @code{subid-range}s that will be serialized to @code{/etc/subgid}.
+If a range doesn't specify a start it will be fitted based on its number of
+requrested subids. If a range doesn't specify a count the default size
+of 65536 will be assumed.
+
+@item @code{subuids} (default: @code{'()}) (type: list-of-subid-ranges)
+The list of @code{subid-range}s that will be serialized to @code{/etc/subuid}.
+If a range doesn't specify a start it will be fitted based on its number of
+requrested subids. If a range doesn't specify a count the default size
+of 65536 will be assumed.
+
+@end table
+
+@end deftp
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} subids-extension
+
+Available @code{subids-extension} fields are:
+
+@table @asis
+
+@item @code{subgids} (default: @code{'()}) (type: list-of-subid-ranges)
+The list of @code{subid-range}s that will be appended to
+@code{subids-configuration-subgids}. Entries with the same name are deduplicated
+upon merging.
+
+@item @code{subuids} (default: @code{'()}) (type: list-of-subid-ranges)
+The list of @code{subid-range}s that will be appended to
+@code{subids-configuration-subuids}. Entries with the same name are deduplicated
+upon merging.
+
+@end table
+
+@end deftp
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} subid-range
+
+The @code{subid-range} record is defined at @code{(gnu system accounts)}.
+Available fields are:
+
+@table @asis
+
+@item @code{name} (type: string)
+The name of the user or group that will own this range.
+
+@item @code{start} (default: @code{#f}) (type: integer)
+The first requested subid. When false the first available subid with enough
+contiguous subids will be assigned.
+
+@item @code{count} (default: @code{#f}) (type: integer)
+The number of total allocated subids. When #f the default of 65536 will be
+assumed .
+
+@end table
+
+@end deftp
+
@c %end of fragment
@node Setuid Programs
diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm
index d8c0cd22a3..943d72694f 100644
--- a/gnu/build/activation.scm
+++ b/gnu/build/activation.scm
@@ -9,6 +9,7 @@
;;; Copyright © 2020 Christine Lemmer-Webber <cwebber@dustycloud.org>
;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
;;; Copyright © 2024 Nicolas Graves <ngraves@ngraves.fr>
+;;; Copyright © 2024 Giacomo Leidi <goodoldpaul@autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -39,6 +40,7 @@ (define-module (gnu build activation)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:export (activate-users+groups
+ activate-subuids+subgids
activate-user-home
activate-etc
activate-setuid-programs
@@ -202,6 +204,23 @@ (define (activate-users+groups users groups)
(chmod directory #o555))
(duplicates (map user-account-home-directory system-accounts))))
+(define (activate-subuids+subgids subuids subgids)
+ "Make sure SUBUIDS (a list of subid range records) and SUBGIDS (a list of
+subid range records) are all available."
+
+ ;; Take same lock as Shadow while we read
+ ;; and write the databases. This ensures there's no race condition with
+ ;; other tools that might be accessing it at the same time.
+ (with-file-lock "/etc/subgid.lock"
+ (let-values (((subuid subgid)
+ (subuid+subgid-databases subuids subgids)))
+ (write-subgid subgid)))
+
+ (with-file-lock "/etc/subuid.lock"
+ (let-values (((subuid subgid)
+ (subuid+subgid-databases subuids subgids)))
+ (write-subuid subuid))))
+
(define (activate-user-home users)
"Create and populate the home directory of USERS, a list of tuples, unless
they already exist."
diff --git a/gnu/local.mk b/gnu/local.mk
index ef1e82eb04..3019747328 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -835,6 +835,7 @@ GNU_SYSTEM_MODULES = \
%D%/tests/samba.scm \
%D%/tests/security.scm \
%D%/tests/security-token.scm \
+ %D%/tests/shadow.scm \
%D%/tests/singularity.scm \
%D%/tests/ssh.scm \
%D%/tests/telephony.scm \
diff --git a/gnu/system/accounts.scm b/gnu/system/accounts.scm
index 1b88ca301f..f63d7f96bd 100644
--- a/gnu/system/accounts.scm
+++ b/gnu/system/accounts.scm
@@ -51,6 +51,7 @@ (define-module (gnu system accounts)
sexp->user-account
sexp->user-group
+ sexp->subid-range
default-shell))
@@ -159,3 +160,12 @@ (define (sexp->user-account sexp)
(create-home-directory? create-home-directory?)
(shell shell) (password password)
(system? system?)))))
+
+(define (sexp->subid-range sexp)
+ "Take SEXP, a tuple as returned by 'subid-range->gexp', and turn it into a
+subid-range record."
+ (match sexp
+ ((name start count)
+ (subid-range (name name)
+ (start start)
+ (count count)))))
diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm
index d9f13271d8..84b5de660b 100644
--- a/gnu/system/shadow.scm
+++ b/gnu/system/shadow.scm
@@ -4,6 +4,7 @@
;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2020, 2023 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2024 Giacomo Leidi <goodoldpaul@autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -77,7 +78,20 @@ (define-module (gnu system shadow)
%base-user-accounts
account-service-type
- account-service))
+ account-service
+
+ subids-configuration
+ subids-configuration?
+ subids-configuration-add-root?
+ subids-configuration-subgids
+ subids-configuration-subuids
+
+ subids-extension
+ subids-extension?
+ subids-extension-subgids
+ subids-extension-subuids
+
+ subids-service-type))
;;; Commentary:
;;;
@@ -380,7 +394,7 @@ (define (assert-valid-users/groups users groups)
;;;
-;;; Service.
+;;; Accounts Service.
;;;
(define (user-group->gexp group)
@@ -521,4 +535,193 @@ (define (account-service accounts+groups skeletons)
(service account-service-type
(append skeletons accounts+groups)))
+
+;;;
+;;; Subids Service.
+;;;
+
+(define %sub-id-min
+ (@@ (gnu build accounts) %sub-id-min))
+(define %sub-id-max
+ (@@ (gnu build accounts) %sub-id-max))
+(define %sub-id-count
+ (@@ (gnu build accounts) %sub-id-count))
+
+(define* (%root-subid #:optional (start %sub-id-min) (count %sub-id-count))
+ (subid-range
+ (name "root")
+ (start start)
+ (count count)))
+
+(define-record-type* <subids-configuration>
+ subids-configuration make-subids-configuration
+ subids-configuration?
+ this-subids-configuration
+
+ (add-root? subids-configuration-add-root? ; boolean
+ (default #t))
+ (subgids subids-configuration-subgids ; list of <subid-range>
+ (default '()))
+ (subuids subids-configuration-subuids ; list of <subid-range>
+ (default '())))
+
+(define (subid-range->gexp range)
+ "Turn RANGE, a <subid-range> object, into a list-valued gexp suitable for
+'activate-subuids+subgids'."
+ (define count (subid-range-count range))
+ #~`(#$(subid-range-name range)
+ #$(subid-range-start range)
+ #$(if (and (number? count)
+ (> count 0))
+ count
+ %sub-id-count)))
+
+(define (assert-valid-subids ranges)
+ (cond ((>= (fold + 0 (map subid-range-count ranges))
+ (- %sub-id-max %sub-id-min -1))
+ (raise
+ (string-append
+ "The configured ranges are more than the "
+ (- %sub-id-max %sub-id-min -1) " max allowed.")))
+ ((any (lambda (r)
+ (define start (subid-range-start r))
+ (and start
+ (< start %sub-id-min)))
+ ranges)
+ (raise
+ (string-append
+ "One subid-range starts before the minimum allowed sub id "
+ %sub-id-min ".")))
+ ((any (lambda (r)
+ (define end (subid-range-end r))
+ (and end
+ (> end %sub-id-max)))
+ ranges)
+ (raise
+ (string-append
+ "One subid-range ends after the maximum allowed sub id "
+ %sub-id-max ".")))
+ ((any (compose null? subid-range-name)
+ ranges)
+ (raise
+ "One subid-range has a null name."))
+ ((any (compose string-null? subid-range-name)
+ ranges)
+ (raise
+ "One subid-range has a name equal to the empty string."))
+ (else #t)))
+
+(define (delete-duplicate-ranges ranges)
+ (delete-duplicates ranges
+ (lambda args
+ (apply string=? (map subid-range-name ranges)))))
+
+(define (subids-activation config)
+ "Return a gexp that activates SUBUIDS+SUBGIDS, a list of <subid-range>
+objects."
+ (define (add-root-when-missing ranges)
+ (define sorted-ranges
+ (sort-list ranges subid-range-less))
+ (define root-missing?
+ (not
+ (find (lambda (r)
+ (string=? "root"
+ (subid-range-name r)))
+ sorted-ranges)))
+ (define first-start
+ (and (> (length sorted-ranges) 0)
+ (subid-range-start (first sorted-ranges))))
+ (define first-has-start?
+ (number? first-start))
+ (define root-start
+ (if first-has-start?
+ (and
+ (> first-start %sub-id-min)
+ %sub-id-min)
+ %sub-id-min))
+ (define root-count
+ (if first-has-start?
+ (- first-start %sub-id-min)
+ %sub-id-count))
+ (if (and root-missing?
+ (subids-configuration-add-root? config))
+ (append (list (%root-subid root-start root-count))
+ sorted-ranges)
+ sorted-ranges))
+
+ (define subuids
+ (delete-duplicate-ranges (subids-configuration-subuids config)))
+
+ (define subuids-specs
+ (map subid-range->gexp (add-root-when-missing subuids)))
+
+ (define subgids
+ (delete-duplicate-ranges (subids-configuration-subgids config)))
+
+ (define subgids-specs
+ (map subid-range->gexp (add-root-when-missing subgids)))
+
+ (assert-valid-subids subgids)
+ (assert-valid-subids subuids)
+
+ ;; Add subuids and subgids.
+ (with-imported-modules (source-module-closure '((gnu system accounts)))
+ #~(begin
+ (use-modules (gnu system accounts))
+
+ (activate-subuids+subgids (map sexp->subid-range (list #$@subuids-specs))
+ (map sexp->subid-range (list #$@subgids-specs))))))
+
+(define-record-type* <subids-extension>
+ subids-extension make-subids-extension
+ subids-extension?
+ this-subids-extension
+
+ (subgids subids-extension-subgids ; list of <subid-range>
+ (default '()))
+ (subuids subids-extension-subuids ; list of <subid-range>
+ (default '())))
+
+(define append-subid-ranges
+ (lambda args
+ (delete-duplicate-ranges
+ (apply append args))))
+
+(define (subids-extension-merge a b)
+ (subids-extension
+ (subgids (append-subid-ranges
+ (subids-extension-subgids a)
+ (subids-extension-subgids b)))
+ (subuids (append-subid-ranges
+ (subids-extension-subuids a)
+ (subids-extension-subuids b)))))
+
+(define subids-service-type
+ (service-type (name 'subids)
+ ;; Concatenate <subid-range> lists.
+ (compose (lambda (args)
+ (fold subids-extension-merge
+ (subids-extension)
+ args)))
+ (extend
+ (lambda (config extension)
+ (subids-configuration
+ (inherit config)
+ (subgids
+ (append-subid-ranges
+ (subids-configuration-subgids config)
+ (subids-extension-subgids extension)))
+ (subuids
+ (append-subid-ranges
+ (subids-configuration-subuids config)
+ (subids-extension-subuids extension))))))
+ (extensions
+ (list (service-extension activation-service-type
+ subids-activation)))
+ (default-value
+ (subids-configuration))
+ (description
+ "Ensure the specified sub UIDs and sub GIDs exist in
+/etc/subuid and /etc/subgid.")))
+
;;; shadow.scm ends here
diff --git a/gnu/tests/shadow.scm b/gnu/tests/shadow.scm
new file mode 100644
index 0000000000..1e755b5438
--- /dev/null
+++ b/gnu/tests/shadow.scm
@@ -0,0 +1,128 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2024 Giacomo Leidi <goodoldpaul@autistici.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu tests shadow)
+ #:use-module (gnu packages base)
+ #:use-module (gnu tests)
+ #:use-module (gnu services)
+ #:use-module (gnu system)
+ #:use-module (gnu system accounts)
+ #:use-module (gnu system shadow)
+ #:use-module (gnu system vm)
+ #:use-module (guix gexp)
+ #:export (%test-subids))
+
+
+(define %subids-os
+ (simple-operating-system
+ (simple-service
+ 'simple-subids
+ subids-service-type
+ (subids-extension
+ (subgids
+ (list
+ (subid-range
+ (name "alice"))
+ (subid-range
+ (name "bob")
+ (start 100700))))
+ (subuids
+ (list
+ (subid-range
+ (name "alice"))))))))
+
+(define (run-subids-test)
+ "Run IMAGE as an OCI backed Shepherd service, inside OS."
+
+ (define os
+ (marionette-operating-system
+ (operating-system-with-gc-roots
+ %subids-os
+ (
This message was truncated. Download the full message here.
P
P
paul wrote on 19 Aug 23:32 +0200
Re: Add /etc/subuid and /etc/subgid support
(address . 72337@debbugs.gnu.org)
230d9bce-25b6-40ab-fa67-14053ba0ef21@autistici.org
Dear Guixers,

I'm sending a patchset rebased on current master. I can confirm tests
still work.

Thank you for your work,

giacomo
G
G
Giacomo Leidi wrote on 20 Aug 00:08 +0200
[PATCH v2 2/3] account: Add /etc/subid and /etc/subgid allocation logic.
(address . 72337@debbugs.gnu.org)(name . Giacomo Leidi)(address . goodoldpaul@autistici.org)
f461750d8557117204b85adfa12ebbedda796f30.1724105284.git.goodoldpaul@autistici.org
* 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(-)

Toggle diff (461 lines)
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 <allocation> 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 <subid-range>. 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* <subid-range>
; 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
G
G
Giacomo Leidi wrote on 20 Aug 00:08 +0200
[PATCH v2 3/3] system: Add /etc/subuid and /etc/subgid support.
(address . 72337@debbugs.gnu.org)(name . Giacomo Leidi)(address . goodoldpaul@autistici.org)
38d9e6a0d242dac361bb62ad6b48b7d0ac7901ae.1724105284.git.goodoldpaul@autistici.org
This commit adds a Guix System service to handle allocation of subuid
and subgid requests. Users that don't care can just add themselves as a
subid-range and don't need to specify anything but their user name.
Users that care about specific ranges, such as possibly LXD, can specify
a start and a count.

* doc/guix.texi: Document the new service.
* gnu/build/activation.scm (activate-subuids+subgids): New variable.
* gnu/local.mk: Add gnu/tests/shadow.scm.
* gnu/system/accounts.scm (sexp->subid-range): New variable.
* gnu/system/shadow.scm (%root-subid): New variable;
(subids-configuration): new record;
(subid-range->gexp): new variable;
(assert-valid-subids): new variable;
(delete-duplicate-ranges): new variable;
(subids-activation): new variable;
(subids-extension): new record;
(append-subid-ranges): new variable;
(subids-extension-merge): new variable;
(subids-service-type): new variable.
* gnu/tests/shadow.scm (subids): New system test.

Change-Id: I3755e1c75771220c74fe8ae5de1a7d90f2376635
---
doc/guix.texi | 171 ++++++++++++++++++++++++++++++++
gnu/build/activation.scm | 19 ++++
gnu/local.mk | 1 +
gnu/system/accounts.scm | 10 ++
gnu/system/shadow.scm | 207 ++++++++++++++++++++++++++++++++++++++-
gnu/tests/shadow.scm | 128 ++++++++++++++++++++++++
6 files changed, 534 insertions(+), 2 deletions(-)
create mode 100644 gnu/tests/shadow.scm

Toggle diff (562 lines)
diff --git a/doc/guix.texi b/doc/guix.texi
index 0e1e253b02..a799342769 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -41647,6 +41647,177 @@ Miscellaneous Services
@end deftp
+@c %end of fragment
+
+@cindex Subids
+@subsubheading Subid Service
+
+The @code{(gnu system shadow)} module exposes the
+@code{subids-service-type}, its configuration record
+@code{subids-configuration} and its extension record
+@code{subids-extension}.
+
+With @code{subids-service-type}, subuids and subgids ranges can be reserved for
+users that desire so:
+
+@lisp
+(use-modules (gnu system shadow) ;for 'subids-service-type'
+ (gnu system accounts) ;for 'subid-range'
+ @dots{})
+
+(operating-system
+ ;; @dots{}
+ (services
+ (list
+ (simple-service 'alice-bob-subids
+ subids-service-type
+ (subids-extension
+ (subgids
+ (list
+ (subid-range (name "alice"))))
+ (subuids
+ (list
+ (subid-range (name "alice"))
+ (subid-range (name "bob")
+ (start 100700)))))))))
+@end lisp
+
+Users (definitely other services), usually, are supposed to extend the service
+instead of adding subids directly to @code{subids-configuration}, unless the
+want to change the default behavior for root. With default settings the
+@code{subids-service-type} adds, if it's not already there, a configuration
+for the root account to both @code{/etc/subuid} and @code{/etc/subgid}, possibly
+starting at the minimum possible subid. Otherwise the root subuids and subgids
+ranges are fitted wherever possible.
+
+The above configuration will yield the following:
+
+@example
+# cat /etc/subgid
+root:100000:65536
+alice:165536:65536
+# cat /etc/subuid
+root:100000:700
+bob:100700:65536
+alice:166236:65536
+@end example
+
+@c %start of fragment
+
+@deftp {Data Type} subids-configuration
+
+With default settings the
+@code{subids-service-type} adds, if it's not already there, a configuration
+for the root account to both @code{/etc/subuid} and @code{/etc/subgid}, possibly
+starting at the minimum possible subid. To disable the default behavior and
+provide your own definition for the root subid ranges you can set to @code{#f}
+the @code{add-root?} field:
+
+@lisp
+(use-modules (gnu system shadow) ;for 'subids-service-type'
+ (gnu system accounts) ;for 'subid-range'
+ @dots{})
+
+(operating-system
+ ;; @dots{}
+ (services
+ (list
+ (service subids-service-type
+ (subids-configuration
+ (add-root? #f)
+ (subgids
+ (subid-range (name "root")
+ (start 120000)
+ (count 100)))
+ (subuids
+ (subid-range (name "root")
+ (start 120000)
+ (count 100)))))
+ (simple-service 'alice-bob-subids
+ subids-service-type
+ (subids-extension
+ (subgids
+ (list
+ (subid-range (name "alice"))))
+ (subuids
+ (list
+ (subid-range (name "alice"))
+ (subid-range (name "bob")
+ (start 100700)))))))))
+@end lisp
+
+Available @code{subids-configuration} fields are:
+
+@table @asis
+@item @code{add-root?} (default: @code{#t}) (type: boolean)
+Whether to automatically configure subuids and subgids for root.
+
+@item @code{subgids} (default: @code{'()}) (type: list-of-subid-ranges)
+The list of @code{subid-range}s that will be serialized to @code{/etc/subgid}.
+If a range doesn't specify a start it will be fitted based on its number of
+requrested subids. If a range doesn't specify a count the default size
+of 65536 will be assumed.
+
+@item @code{subuids} (default: @code{'()}) (type: list-of-subid-ranges)
+The list of @code{subid-range}s that will be serialized to @code{/etc/subuid}.
+If a range doesn't specify a start it will be fitted based on its number of
+requrested subids. If a range doesn't specify a count the default size
+of 65536 will be assumed.
+
+@end table
+
+@end deftp
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} subids-extension
+
+Available @code{subids-extension} fields are:
+
+@table @asis
+
+@item @code{subgids} (default: @code{'()}) (type: list-of-subid-ranges)
+The list of @code{subid-range}s that will be appended to
+@code{subids-configuration-subgids}. Entries with the same name are deduplicated
+upon merging.
+
+@item @code{subuids} (default: @code{'()}) (type: list-of-subid-ranges)
+The list of @code{subid-range}s that will be appended to
+@code{subids-configuration-subuids}. Entries with the same name are deduplicated
+upon merging.
+
+@end table
+
+@end deftp
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} subid-range
+
+The @code{subid-range} record is defined at @code{(gnu system accounts)}.
+Available fields are:
+
+@table @asis
+
+@item @code{name} (type: string)
+The name of the user or group that will own this range.
+
+@item @code{start} (default: @code{#f}) (type: integer)
+The first requested subid. When false the first available subid with enough
+contiguous subids will be assigned.
+
+@item @code{count} (default: @code{#f}) (type: integer)
+The number of total allocated subids. When #f the default of 65536 will be
+assumed .
+
+@end table
+
+@end deftp
+
@c %end of fragment
@node Privileged Programs
diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm
index a57ca78a86..91662fe0fd 100644
--- a/gnu/build/activation.scm
+++ b/gnu/build/activation.scm
@@ -10,6 +10,7 @@
;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
;;; Copyright © 2022 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2024 Nicolas Graves <ngraves@ngraves.fr>
+;;; Copyright © 2024 Giacomo Leidi <goodoldpaul@autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -40,6 +41,7 @@ (define-module (gnu build activation)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:export (activate-users+groups
+ activate-subuids+subgids
activate-user-home
activate-etc
activate-privileged-programs
@@ -203,6 +205,23 @@ (define (activate-users+groups users groups)
(chmod directory #o555))
(duplicates (map user-account-home-directory system-accounts))))
+(define (activate-subuids+subgids subuids subgids)
+ "Make sure SUBUIDS (a list of subid range records) and SUBGIDS (a list of
+subid range records) are all available."
+
+ ;; Take same lock as Shadow while we read
+ ;; and write the databases. This ensures there's no race condition with
+ ;; other tools that might be accessing it at the same time.
+ (with-file-lock "/etc/subgid.lock"
+ (let-values (((subuid subgid)
+ (subuid+subgid-databases subuids subgids)))
+ (write-subgid subgid)))
+
+ (with-file-lock "/etc/subuid.lock"
+ (let-values (((subuid subgid)
+ (subuid+subgid-databases subuids subgids)))
+ (write-subuid subuid))))
+
(define (activate-user-home users)
"Create and populate the home directory of USERS, a list of tuples, unless
they already exist."
diff --git a/gnu/local.mk b/gnu/local.mk
index 3b0a3858f7..88467e3d42 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -839,6 +839,7 @@ GNU_SYSTEM_MODULES = \
%D%/tests/samba.scm \
%D%/tests/security.scm \
%D%/tests/security-token.scm \
+ %D%/tests/shadow.scm \
%D%/tests/singularity.scm \
%D%/tests/ssh.scm \
%D%/tests/telephony.scm \
diff --git a/gnu/system/accounts.scm b/gnu/system/accounts.scm
index 1b88ca301f..f63d7f96bd 100644
--- a/gnu/system/accounts.scm
+++ b/gnu/system/accounts.scm
@@ -51,6 +51,7 @@ (define-module (gnu system accounts)
sexp->user-account
sexp->user-group
+ sexp->subid-range
default-shell))
@@ -159,3 +160,12 @@ (define (sexp->user-account sexp)
(create-home-directory? create-home-directory?)
(shell shell) (password password)
(system? system?)))))
+
+(define (sexp->subid-range sexp)
+ "Take SEXP, a tuple as returned by 'subid-range->gexp', and turn it into a
+subid-range record."
+ (match sexp
+ ((name start count)
+ (subid-range (name name)
+ (start start)
+ (count count)))))
diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm
index d9f13271d8..84b5de660b 100644
--- a/gnu/system/shadow.scm
+++ b/gnu/system/shadow.scm
@@ -4,6 +4,7 @@
;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2020, 2023 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2024 Giacomo Leidi <goodoldpaul@autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -77,7 +78,20 @@ (define-module (gnu system shadow)
%base-user-accounts
account-service-type
- account-service))
+ account-service
+
+ subids-configuration
+ subids-configuration?
+ subids-configuration-add-root?
+ subids-configuration-subgids
+ subids-configuration-subuids
+
+ subids-extension
+ subids-extension?
+ subids-extension-subgids
+ subids-extension-subuids
+
+ subids-service-type))
;;; Commentary:
;;;
@@ -380,7 +394,7 @@ (define (assert-valid-users/groups users groups)
;;;
-;;; Service.
+;;; Accounts Service.
;;;
(define (user-group->gexp group)
@@ -521,4 +535,193 @@ (define (account-service accounts+groups skeletons)
(service account-service-type
(append skeletons accounts+groups)))
+
+;;;
+;;; Subids Service.
+;;;
+
+(define %sub-id-min
+ (@@ (gnu build accounts) %sub-id-min))
+(define %sub-id-max
+ (@@ (gnu build accounts) %sub-id-max))
+(define %sub-id-count
+ (@@ (gnu build accounts) %sub-id-count))
+
+(define* (%root-subid #:optional (start %sub-id-min) (count %sub-id-count))
+ (subid-range
+ (name "root")
+ (start start)
+ (count count)))
+
+(define-record-type* <subids-configuration>
+ subids-configuration make-subids-configuration
+ subids-configuration?
+ this-subids-configuration
+
+ (add-root? subids-configuration-add-root? ; boolean
+ (default #t))
+ (subgids subids-configuration-subgids ; list of <subid-range>
+ (default '()))
+ (subuids subids-configuration-subuids ; list of <subid-range>
+ (default '())))
+
+(define (subid-range->gexp range)
+ "Turn RANGE, a <subid-range> object, into a list-valued gexp suitable for
+'activate-subuids+subgids'."
+ (define count (subid-range-count range))
+ #~`(#$(subid-range-name range)
+ #$(subid-range-start range)
+ #$(if (and (number? count)
+ (> count 0))
+ count
+ %sub-id-count)))
+
+(define (assert-valid-subids ranges)
+ (cond ((>= (fold + 0 (map subid-range-count ranges))
+ (- %sub-id-max %sub-id-min -1))
+ (raise
+ (string-append
+ "The configured ranges are more than the "
+ (- %sub-id-max %sub-id-min -1) " max allowed.")))
+ ((any (lambda (r)
+ (define start (subid-range-start r))
+ (and start
+ (< start %sub-id-min)))
+ ranges)
+ (raise
+ (string-append
+ "One subid-range starts before the minimum allowed sub id "
+ %sub-id-min ".")))
+ ((any (lambda (r)
+ (define end (subid-range-end r))
+ (and end
+ (> end %sub-id-max)))
+ ranges)
+ (raise
+ (string-append
+ "One subid-range ends after the maximum allowed sub id "
+ %sub-id-max ".")))
+ ((any (compose null? subid-range-name)
+ ranges)
+ (raise
+ "One subid-range has a null name."))
+ ((any (compose string-null? subid-range-name)
+ ranges)
+ (raise
+ "One subid-range has a name equal to the empty string."))
+ (else #t)))
+
+(define (delete-duplicate-ranges ranges)
+ (delete-duplicates ranges
+ (lambda args
+ (apply string=? (map subid-range-name ranges)))))
+
+(define (subids-activation config)
+ "Return a gexp that activates SUBUIDS+SUBGIDS, a list of <subid-range>
+objects."
+ (define (add-root-when-missing ranges)
+ (define sorted-ranges
+ (sort-list ranges subid-range-less))
+ (define root-missing?
+ (not
+ (find (lambda (r)
+ (string=? "root"
+ (subid-range-name r)))
+ sorted-ranges)))
+ (define first-start
+ (and (> (length sorted-ranges) 0)
+ (subid-range-start (first sorted-ranges))))
+ (define first-has-start?
+ (number? first-start))
+ (define root-start
+ (if first-has-start?
+ (and
+ (> first-start %sub-id-min)
+ %sub-id-min)
+ %sub-id-min))
+ (define root-count
+ (if first-has-start?
+ (- first-start %sub-id-min)
+ %sub-id-count))
+ (if (and root-missing?
+ (subids-configuration-add-root? config))
+ (append (list (%root-subid root-start root-count))
+ sorted-ranges)
+ sorted-ranges))
+
+ (define subuids
+ (delete-duplicate-ranges (subids-configuration-subuids config)))
+
+ (define subuids-specs
+ (map subid-range->gexp (add-root-when-missing subuids)))
+
+ (define subgids
+ (delete-duplicate-ranges (subids-configuration-subgids config)))
+
+ (define subgids-specs
+ (map subid-range->gexp (add-root-when-missing subgids)))
+
+ (assert-valid-subids subgids)
+ (assert-valid-subids subuids)
+
+ ;; Add subuids and subgids.
+ (with-imported-modules (source-module-closure '((gnu system accounts)))
+ #~(begin
+ (use-modules (gnu system accounts))
+
+ (activate-subuids+subgids (map sexp->subid-range (list #$@subuids-specs))
+ (map sexp->subid-range (list #$@subgids-specs))))))
+
+(define-record-type* <subids-extension>
+ subids-extension make-subids-extension
+ subids-extension?
+ this-subids-extension
+
+ (subgids subids-extension-subgids ; list of <subid-range>
+ (default '()))
+ (subuids subids-extension-subuids ; list of <subid-range>
+ (default '())))
+
+(define append-subid-ranges
+ (lambda args
+ (delete-duplicate-ranges
+ (apply append args))))
+
+(define (subids-extension-merge a b)
+ (subids-extension
+ (subgids (append-subid-ranges
+ (subids-extension-subgids a)
+ (subids-extension-subgids b)))
+ (subuids (append-subid-ranges
+ (subids-extension-subuids a)
+ (subids-extension-subuids b)))))
+
+(define subids-service-type
+ (service-type (name 'subids)
+ ;; Concatenate <subid-range> lists.
+ (compose (lambda (args)
+ (fold subids-extension-merge
+ (subids-extension)
+ args)))
+ (extend
+ (lambda (config extension)
+ (subids-configuration
+ (inherit config)
+ (subgids
+ (append-subid-ranges
+ (subids-configuration-subgids config)
+ (subids-extension-subgids extension)))
+ (subuids
+ (append-subid-ranges
+ (subids-configuration-subuids config)
+ (subids-extension-subuids extension))))))
+ (extensions
+ (list (service-extension activation-service-type
+ subids-activation)))
+ (default-value
+ (subids-configuration))
+ (description
+ "Ensure the specified sub UIDs and sub GIDs exist in
+/etc/subuid and /etc/subgid.")))
+
;;; shadow.scm ends here
diff --git a/gnu/tests/shadow.scm b/gnu/tests/shadow.scm
new file mode 100644
index 0000000000..1e755b5438
--- /dev/null
+++ b/gnu/tests/shadow.scm
@@ -0,0 +1,128 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2024 Giacomo Leidi <goodoldpaul@autistici.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu tests shadow)
+ #:use-module (gnu packages base)
+ #:use-module (gnu tests)
+ #:use-module (gnu services)
+ #:use-module (gnu system)
+ #:use-module (gnu system accounts)
+ #:use-module (gnu system shadow)
+ #:use-module (gnu system vm)
+ #:use-module (guix gexp)
+ #:export (%test-subids))
+
+
+(define %subids-os
+ (simple-operating-system
+ (simple-service
+ 'simple-subids
+ subids-service-type
+ (subids-extension
+ (subgids
+ (list
+ (subid-range
+ (name "alice"))
+ (subid-range
+ (name "bob")
+ (start 100700))))
+ (subuids
+ (list
+ (subid-range
+ (name "alice"))))))))
+
+(define (run-subids-test)
+ "Run IMAGE as an OCI backed Shepherd service, inside OS."
+
+ (define os
+ (marionette-operating-system
+ (operating-system-with-gc-roots
+ %subids-os
+ (li
This message was truncated. Download the full message here.
G
G
Giacomo Leidi wrote on 20 Aug 00:08 +0200
[PATCH v2 1/3] accounts: Add /etc/subuid and /etc/subgid support.
(address . 72337@debbugs.gnu.org)(name . Giacomo Leidi)(address . goodoldpaul@autistici.org)
ea47c9ba31ab1700d10c518d8be25238586dec33.1724105284.git.goodoldpaul@autistici.org
This commit adds a new record type, <subid-entry> and serializers
and deserializers for it in (gnu build accounts). Each instance of this
record represents one line in either /etc/subuid or /etc/subgid. Since
Shadow uses the same representation for both files, it should be ok if
we do it as well.

This commit adds also <subid-range>, a user facing representation of
<subid-entry>. It is supposed to be usable directly in OS configurations.

* gnu/build/accounts.scm (subid-entry): New record;
(write-subgid): add serializer for subgids;
(write-subuid): add serializer for subuids;
(read-subgid): add serializer for subgids;
(read-subuid): add serializer for subuids.
* gnu/system/accounts.scm (subid-range): New record.
* test/accounts.scm: Test them.

Change-Id: I6b037e40e354c069bf556412bb5b626bd3ea1b2c
---
gnu/build/accounts.scm | 37 ++++++++++++++++++++++++---
gnu/system/accounts.scm | 17 +++++++++++++
tests/accounts.scm | 55 +++++++++++++++++++++++++++++++++++++++++
3 files changed, 106 insertions(+), 3 deletions(-)

Toggle diff (215 lines)
diff --git a/gnu/build/accounts.scm b/gnu/build/accounts.scm
index fa6f454b5e..ea8c69f205 100644
--- a/gnu/build/accounts.scm
+++ b/gnu/build/accounts.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019, 2021, 2023 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2024 Giacomo Leidi <goodoldpaul@autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -51,13 +52,23 @@ (define-module (gnu build accounts)
group-entry-gid
group-entry-members
+ subid-entry
+ subid-entry?
+ subid-entry-name
+ subid-entry-start
+ subid-entry-count
+
%password-lock-file
write-group
write-passwd
write-shadow
+ write-subgid
+ write-subuid
read-group
read-passwd
read-shadow
+ read-subgid
+ read-subuid
%id-min
%id-max
@@ -68,11 +79,12 @@ (define-module (gnu build accounts)
;;; Commentary:
;;;
-;;; This modules provides functionality equivalent to the C library's
+;;; This module provides functionality equivalent to the C library's
;;; <shadow.h>, <pwd.h>, and <grp.h> routines, as well as a subset of the
;;; functionality of the Shadow command-line tools. It can parse and write
-;;; /etc/passwd, /etc/shadow, and /etc/group. It can also take care of UID
-;;; and GID allocation in a way similar to what 'useradd' does.
+;;; /etc/passwd, /etc/shadow, /etc/group, /etc/subuid and /etc/subgid. It can
+;;; also take care of UID and GID allocation in a way similar to what 'useradd'
+;;; does. The same goes for sub UID and sub GID allocation.
;;;
;;; The benefit is twofold: less code is involved, and the ID allocation
;;; strategy and state preservation is made explicit.
@@ -225,6 +237,17 @@ (define-database-entry <group-entry> ;<grp.h>
(serialization list->comma-separated comma-separated->list)
(default '())))
+(define-database-entry <subid-entry> ;<subid.h>
+ subid-entry make-subid-entry
+ subid-entry?
+ (serialization #\: subid-entry->string string->subid-entry)
+
+ (name subid-entry-name)
+ (start subid-entry-start
+ (serialization number->string string->number))
+ (count subid-entry-count
+ (serialization number->string string->number)))
+
(define %password-lock-file
;; The password database lock file used by libc's 'lckpwdf'. Users should
;; grab this lock with 'with-file-lock' when they access the databases.
@@ -265,6 +288,10 @@ (define write-shadow
(database-writer "/etc/shadow" #o600 shadow-entry->string))
(define write-group
(database-writer "/etc/group" #o644 group-entry->string))
+(define write-subuid
+ (database-writer "/etc/subuid" #o644 subid-entry->string))
+(define write-subgid
+ (database-writer "/etc/subgid" #o644 subid-entry->string))
(define (database-reader file string->entry)
(lambda* (#:optional (file-or-port file))
@@ -287,6 +314,10 @@ (define read-shadow
(database-reader "/etc/shadow" string->shadow-entry))
(define read-group
(database-reader "/etc/group" string->group-entry))
+(define read-subuid
+ (database-reader "/etc/subuid" string->subid-entry))
+(define read-subgid
+ (database-reader "/etc/subgid" string->subid-entry))
;;;
diff --git a/gnu/system/accounts.scm b/gnu/system/accounts.scm
index 586cff1842..9a006c188d 100644
--- a/gnu/system/accounts.scm
+++ b/gnu/system/accounts.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2024 Giacomo Leidi <goodoldpaul@autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -39,6 +40,12 @@ (define-module (gnu system accounts)
user-group-id
user-group-system?
+ subid-range
+ subid-range?
+ subid-range-name
+ subid-range-start
+ subid-range-count
+
sexp->user-account
sexp->user-group
@@ -85,6 +92,16 @@ (define-record-type* <user-group>
(system? user-group-system? ; Boolean
(default #f)))
+(define-record-type* <subid-range>
+ subid-range make-subid-range
+ subid-range?
+ (name subid-range-name)
+ (start subid-range-start (default #f)) ; number
+ (count subid-range-count ; number
+ ; from find_new_sub_gids.c and
+ ; find_new_sub_uids.c
+ (default 65536)))
+
(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 78136390bb..4944c22f49 100644
--- a/tests/accounts.scm
+++ b/tests/accounts.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2024 Giacomo Leidi <goodoldpaul@autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -41,6 +42,16 @@ (define %shadow-sample
charlie:" (crypt "hey!" "$6$abc") ":17169::::::
nobody:!:0::::::\n"))
+(define %subuid-sample
+ "\
+root:100000:300
+ada:100300:300\n")
+
+(define %subgid-sample
+ "\
+root:100000:600
+ada:100600:300\n")
+
(test-begin "accounts")
@@ -135,6 +146,50 @@ (define %shadow-sample
read-shadow)
port))))
+(test-equal "write-subuid"
+ %subuid-sample
+ (call-with-output-string
+ (lambda (port)
+ (write-subuid (list (subid-entry
+ (name "root")
+ (start 100000)
+ (count 300))
+ (subid-entry
+ (name "ada")
+ (start 100300)
+ (count 300)))
+ port))))
+
+(test-equal "read-subuid + write-subuid"
+ %subuid-sample
+ (call-with-output-string
+ (lambda (port)
+ (write-subuid (call-with-input-string %subuid-sample
+ read-subuid)
+ port))))
+
+(test-equal "write-subgid"
+ %subgid-sample
+ (call-with-output-string
+ (lambda (port)
+ (write-subgid (list (subid-entry
+ (name "root")
+ (start 100000)
+ (count 600))
+ (subid-entry
+ (name "ada")
+ (start 100600)
+ (count 300)))
+ port))))
+
+(test-equal "read-subgid + write-subgid"
+ %subgid-sample
+ (call-with-output-string
+ (lambda (port)
+ (write-subgid (call-with-input-string %subgid-sample
+ read-subgid)
+ port))))
+
(define allocate-groups (@@ (gnu build accounts) allocate-groups))
(define allocate-passwd (@@ (gnu build accounts) allocate-passwd))

base-commit: 00245fdcd4909d7e6b20fe88f5d089717115adc1
--
2.45.2
P
P
paul wrote on 21 Aug 00:12 +0200
Re: Add /etc/subuid and /etc/subgid support
(address . 72337@debbugs.gnu.org)
b95021b0-2bd5-2546-3838-c353407b4234@autistici.org
Dear Guixers,


I'm sending a v3. This patchset brings a small fix where numbers where
not converted to strings in error messages string-append calls.


Thank you for your time,


giacomo
G
G
Giacomo Leidi wrote on 21 Aug 00:14 +0200
[PATCH v3 2/3] account: Add /etc/subid and /etc/subgid allocation logic.
(address . 72337@debbugs.gnu.org)(name . Giacomo Leidi)(address . goodoldpaul@autistici.org)
5b955b5c53e8e2c7c3173c87ca17758505e960ae.1724192097.git.goodoldpaul@autistici.org
* 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 | 231 +++++++++++++++++++++++++++++++++++++++-
gnu/system/accounts.scm | 30 ++++++
tests/accounts.scm | 108 +++++++++++++++++++
3 files changed, 368 insertions(+), 1 deletion(-)

Toggle diff (463 lines)
diff --git a/gnu/build/accounts.scm b/gnu/build/accounts.scm
index ea8c69f205..780cb5f7ff 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 <allocation> record
based on ASSIGNMENT. If SYSTEM? is true, return a system ID."
@@ -405,6 +431,158 @@ (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 " (number->string range-start) " to "
+ (number->string range-end)
+ " spans over illegal subids. Max allowed is "
+ (number->string %sub-id-max) ", min is "
+ (number->string %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 +718,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 <subid-range>. 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 +818,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* <subid-range>
; 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
G
G
Giacomo Leidi wrote on 21 Aug 00:14 +0200
[PATCH v3 3/3] system: Add /etc/subuid and /etc/subgid support.
(address . 72337@debbugs.gnu.org)(name . Giacomo Leidi)(address . goodoldpaul@autistici.org)
8b0b9421e1347e0f0d6ce88c8eb66a5b6296cc0c.1724192097.git.goodoldpaul@autistici.org
This commit adds a Guix System service to handle allocation of subuid
and subgid requests. Users that don't care can just add themselves as a
subid-range and don't need to specify anything but their user name.
Users that care about specific ranges, such as possibly LXD, can specify
a start and a count.

* doc/guix.texi: Document the new service.
* gnu/build/activation.scm (activate-subuids+subgids): New variable.
* gnu/local.mk: Add gnu/tests/shadow.scm.
* gnu/system/accounts.scm (sexp->subid-range): New variable.
* gnu/system/shadow.scm (%root-subid): New variable;
(subids-configuration): new record;
(subid-range->gexp): new variable;
(assert-valid-subids): new variable;
(delete-duplicate-ranges): new variable;
(subids-activation): new variable;
(subids-extension): new record;
(append-subid-ranges): new variable;
(subids-extension-merge): new variable;
(subids-service-type): new variable.
* gnu/tests/shadow.scm (subids): New system test.

Change-Id: I3755e1c75771220c74fe8ae5de1a7d90f2376635
---
doc/guix.texi | 171 ++++++++++++++++++++++++++++++++
gnu/build/activation.scm | 19 ++++
gnu/local.mk | 1 +
gnu/system/accounts.scm | 10 ++
gnu/system/shadow.scm | 208 ++++++++++++++++++++++++++++++++++++++-
gnu/tests/shadow.scm | 128 ++++++++++++++++++++++++
6 files changed, 535 insertions(+), 2 deletions(-)
create mode 100644 gnu/tests/shadow.scm

Toggle diff (561 lines)
diff --git a/doc/guix.texi b/doc/guix.texi
index 0e1e253b02..a799342769 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -41647,6 +41647,177 @@ Miscellaneous Services
@end deftp
+@c %end of fragment
+
+@cindex Subids
+@subsubheading Subid Service
+
+The @code{(gnu system shadow)} module exposes the
+@code{subids-service-type}, its configuration record
+@code{subids-configuration} and its extension record
+@code{subids-extension}.
+
+With @code{subids-service-type}, subuids and subgids ranges can be reserved for
+users that desire so:
+
+@lisp
+(use-modules (gnu system shadow) ;for 'subids-service-type'
+ (gnu system accounts) ;for 'subid-range'
+ @dots{})
+
+(operating-system
+ ;; @dots{}
+ (services
+ (list
+ (simple-service 'alice-bob-subids
+ subids-service-type
+ (subids-extension
+ (subgids
+ (list
+ (subid-range (name "alice"))))
+ (subuids
+ (list
+ (subid-range (name "alice"))
+ (subid-range (name "bob")
+ (start 100700)))))))))
+@end lisp
+
+Users (definitely other services), usually, are supposed to extend the service
+instead of adding subids directly to @code{subids-configuration}, unless the
+want to change the default behavior for root. With default settings the
+@code{subids-service-type} adds, if it's not already there, a configuration
+for the root account to both @code{/etc/subuid} and @code{/etc/subgid}, possibly
+starting at the minimum possible subid. Otherwise the root subuids and subgids
+ranges are fitted wherever possible.
+
+The above configuration will yield the following:
+
+@example
+# cat /etc/subgid
+root:100000:65536
+alice:165536:65536
+# cat /etc/subuid
+root:100000:700
+bob:100700:65536
+alice:166236:65536
+@end example
+
+@c %start of fragment
+
+@deftp {Data Type} subids-configuration
+
+With default settings the
+@code{subids-service-type} adds, if it's not already there, a configuration
+for the root account to both @code{/etc/subuid} and @code{/etc/subgid}, possibly
+starting at the minimum possible subid. To disable the default behavior and
+provide your own definition for the root subid ranges you can set to @code{#f}
+the @code{add-root?} field:
+
+@lisp
+(use-modules (gnu system shadow) ;for 'subids-service-type'
+ (gnu system accounts) ;for 'subid-range'
+ @dots{})
+
+(operating-system
+ ;; @dots{}
+ (services
+ (list
+ (service subids-service-type
+ (subids-configuration
+ (add-root? #f)
+ (subgids
+ (subid-range (name "root")
+ (start 120000)
+ (count 100)))
+ (subuids
+ (subid-range (name "root")
+ (start 120000)
+ (count 100)))))
+ (simple-service 'alice-bob-subids
+ subids-service-type
+ (subids-extension
+ (subgids
+ (list
+ (subid-range (name "alice"))))
+ (subuids
+ (list
+ (subid-range (name "alice"))
+ (subid-range (name "bob")
+ (start 100700)))))))))
+@end lisp
+
+Available @code{subids-configuration} fields are:
+
+@table @asis
+@item @code{add-root?} (default: @code{#t}) (type: boolean)
+Whether to automatically configure subuids and subgids for root.
+
+@item @code{subgids} (default: @code{'()}) (type: list-of-subid-ranges)
+The list of @code{subid-range}s that will be serialized to @code{/etc/subgid}.
+If a range doesn't specify a start it will be fitted based on its number of
+requrested subids. If a range doesn't specify a count the default size
+of 65536 will be assumed.
+
+@item @code{subuids} (default: @code{'()}) (type: list-of-subid-ranges)
+The list of @code{subid-range}s that will be serialized to @code{/etc/subuid}.
+If a range doesn't specify a start it will be fitted based on its number of
+requrested subids. If a range doesn't specify a count the default size
+of 65536 will be assumed.
+
+@end table
+
+@end deftp
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} subids-extension
+
+Available @code{subids-extension} fields are:
+
+@table @asis
+
+@item @code{subgids} (default: @code{'()}) (type: list-of-subid-ranges)
+The list of @code{subid-range}s that will be appended to
+@code{subids-configuration-subgids}. Entries with the same name are deduplicated
+upon merging.
+
+@item @code{subuids} (default: @code{'()}) (type: list-of-subid-ranges)
+The list of @code{subid-range}s that will be appended to
+@code{subids-configuration-subuids}. Entries with the same name are deduplicated
+upon merging.
+
+@end table
+
+@end deftp
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} subid-range
+
+The @code{subid-range} record is defined at @code{(gnu system accounts)}.
+Available fields are:
+
+@table @asis
+
+@item @code{name} (type: string)
+The name of the user or group that will own this range.
+
+@item @code{start} (default: @code{#f}) (type: integer)
+The first requested subid. When false the first available subid with enough
+contiguous subids will be assigned.
+
+@item @code{count} (default: @code{#f}) (type: integer)
+The number of total allocated subids. When #f the default of 65536 will be
+assumed .
+
+@end table
+
+@end deftp
+
@c %end of fragment
@node Privileged Programs
diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm
index a57ca78a86..91662fe0fd 100644
--- a/gnu/build/activation.scm
+++ b/gnu/build/activation.scm
@@ -10,6 +10,7 @@
;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
;;; Copyright © 2022 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2024 Nicolas Graves <ngraves@ngraves.fr>
+;;; Copyright © 2024 Giacomo Leidi <goodoldpaul@autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -40,6 +41,7 @@ (define-module (gnu build activation)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:export (activate-users+groups
+ activate-subuids+subgids
activate-user-home
activate-etc
activate-privileged-programs
@@ -203,6 +205,23 @@ (define (activate-users+groups users groups)
(chmod directory #o555))
(duplicates (map user-account-home-directory system-accounts))))
+(define (activate-subuids+subgids subuids subgids)
+ "Make sure SUBUIDS (a list of subid range records) and SUBGIDS (a list of
+subid range records) are all available."
+
+ ;; Take same lock as Shadow while we read
+ ;; and write the databases. This ensures there's no race condition with
+ ;; other tools that might be accessing it at the same time.
+ (with-file-lock "/etc/subgid.lock"
+ (let-values (((subuid subgid)
+ (subuid+subgid-databases subuids subgids)))
+ (write-subgid subgid)))
+
+ (with-file-lock "/etc/subuid.lock"
+ (let-values (((subuid subgid)
+ (subuid+subgid-databases subuids subgids)))
+ (write-subuid subuid))))
+
(define (activate-user-home users)
"Create and populate the home directory of USERS, a list of tuples, unless
they already exist."
diff --git a/gnu/local.mk b/gnu/local.mk
index 3b0a3858f7..88467e3d42 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -839,6 +839,7 @@ GNU_SYSTEM_MODULES = \
%D%/tests/samba.scm \
%D%/tests/security.scm \
%D%/tests/security-token.scm \
+ %D%/tests/shadow.scm \
%D%/tests/singularity.scm \
%D%/tests/ssh.scm \
%D%/tests/telephony.scm \
diff --git a/gnu/system/accounts.scm b/gnu/system/accounts.scm
index 1b88ca301f..f63d7f96bd 100644
--- a/gnu/system/accounts.scm
+++ b/gnu/system/accounts.scm
@@ -51,6 +51,7 @@ (define-module (gnu system accounts)
sexp->user-account
sexp->user-group
+ sexp->subid-range
default-shell))
@@ -159,3 +160,12 @@ (define (sexp->user-account sexp)
(create-home-directory? create-home-directory?)
(shell shell) (password password)
(system? system?)))))
+
+(define (sexp->subid-range sexp)
+ "Take SEXP, a tuple as returned by 'subid-range->gexp', and turn it into a
+subid-range record."
+ (match sexp
+ ((name start count)
+ (subid-range (name name)
+ (start start)
+ (count count)))))
diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm
index d9f13271d8..f0129afe8e 100644
--- a/gnu/system/shadow.scm
+++ b/gnu/system/shadow.scm
@@ -4,6 +4,7 @@
;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2020, 2023 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2024 Giacomo Leidi <goodoldpaul@autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -77,7 +78,20 @@ (define-module (gnu system shadow)
%base-user-accounts
account-service-type
- account-service))
+ account-service
+
+ subids-configuration
+ subids-configuration?
+ subids-configuration-add-root?
+ subids-configuration-subgids
+ subids-configuration-subuids
+
+ subids-extension
+ subids-extension?
+ subids-extension-subgids
+ subids-extension-subuids
+
+ subids-service-type))
;;; Commentary:
;;;
@@ -380,7 +394,7 @@ (define (assert-valid-users/groups users groups)
;;;
-;;; Service.
+;;; Accounts Service.
;;;
(define (user-group->gexp group)
@@ -521,4 +535,194 @@ (define (account-service accounts+groups skeletons)
(service account-service-type
(append skeletons accounts+groups)))
+
+;;;
+;;; Subids Service.
+;;;
+
+(define %sub-id-min
+ (@@ (gnu build accounts) %sub-id-min))
+(define %sub-id-max
+ (@@ (gnu build accounts) %sub-id-max))
+(define %sub-id-count
+ (@@ (gnu build accounts) %sub-id-count))
+
+(define* (%root-subid #:optional (start %sub-id-min) (count %sub-id-count))
+ (subid-range
+ (name "root")
+ (start start)
+ (count count)))
+
+(define-record-type* <subids-configuration>
+ subids-configuration make-subids-configuration
+ subids-configuration?
+ this-subids-configuration
+
+ (add-root? subids-configuration-add-root? ; boolean
+ (default #t))
+ (subgids subids-configuration-subgids ; list of <subid-range>
+ (default '()))
+ (subuids subids-configuration-subuids ; list of <subid-range>
+ (default '())))
+
+(define (subid-range->gexp range)
+ "Turn RANGE, a <subid-range> object, into a list-valued gexp suitable for
+'activate-subuids+subgids'."
+ (define count (subid-range-count range))
+ #~`(#$(subid-range-name range)
+ #$(subid-range-start range)
+ #$(if (and (number? count)
+ (> count 0))
+ count
+ %sub-id-count)))
+
+(define (assert-valid-subids ranges)
+ (cond ((>= (fold + 0 (map subid-range-count ranges))
+ (- %sub-id-max %sub-id-min -1))
+ (raise
+ (string-append
+ "The configured ranges are more than the "
+ (number->string
+ (- %sub-id-max %sub-id-min -1)) " max allowed.")))
+ ((any (lambda (r)
+ (define start (subid-range-start r))
+ (and start
+ (< start %sub-id-min)))
+ ranges)
+ (raise
+ (string-append
+ "One subid-range starts before the minimum allowed sub id "
+ (number->string %sub-id-min) ".")))
+ ((any (lambda (r)
+ (define end (subid-range-end r))
+ (and end
+ (> end %sub-id-max)))
+ ranges)
+ (raise
+ (string-append
+ "One subid-range ends after the maximum allowed sub id "
+ (number->string %sub-id-max) ".")))
+ ((any (compose null? subid-range-name)
+ ranges)
+ (raise
+ "One subid-range has a null name."))
+ ((any (compose string-null? subid-range-name)
+ ranges)
+ (raise
+ "One subid-range has a name equal to the empty string."))
+ (else #t)))
+
+(define (delete-duplicate-ranges ranges)
+ (delete-duplicates ranges
+ (lambda args
+ (apply string=? (map subid-range-name ranges)))))
+
+(define (subids-activation config)
+ "Return a gexp that activates SUBUIDS+SUBGIDS, a list of <subid-range>
+objects."
+ (define (add-root-when-missing ranges)
+ (define sorted-ranges
+ (sort-list ranges subid-range-less))
+ (define root-missing?
+ (not
+ (find (lambda (r)
+ (string=? "root"
+ (subid-range-name r)))
+ sorted-ranges)))
+ (define first-start
+ (and (> (length sorted-ranges) 0)
+ (subid-range-start (first sorted-ranges))))
+ (define first-has-start?
+ (number? first-start))
+ (define root-start
+ (if first-has-start?
+ (and
+ (> first-start %sub-id-min)
+ %sub-id-min)
+ %sub-id-min))
+ (define root-count
+ (if first-has-start?
+ (- first-start %sub-id-min)
+ %sub-id-count))
+ (if (and root-missing?
+ (subids-configuration-add-root? config))
+ (append (list (%root-subid root-start root-count))
+ sorted-ranges)
+ sorted-ranges))
+
+ (define subuids
+ (delete-duplicate-ranges (subids-configuration-subuids config)))
+
+ (define subuids-specs
+ (map subid-range->gexp (add-root-when-missing subuids)))
+
+ (define subgids
+ (delete-duplicate-ranges (subids-configuration-subgids config)))
+
+ (define subgids-specs
+ (map subid-range->gexp (add-root-when-missing subgids)))
+
+ (assert-valid-subids subgids)
+ (assert-valid-subids subuids)
+
+ ;; Add subuids and subgids.
+ (with-imported-modules (source-module-closure '((gnu system accounts)))
+ #~(begin
+ (use-modules (gnu system accounts))
+
+ (activate-subuids+subgids (map sexp->subid-range (list #$@subuids-specs))
+ (map sexp->subid-range (list #$@subgids-specs))))))
+
+(define-record-type* <subids-extension>
+ subids-extension make-subids-extension
+ subids-extension?
+ this-subids-extension
+
+ (subgids subids-extension-subgids ; list of <subid-range>
+ (default '()))
+ (subuids subids-extension-subuids ; list of <subid-range>
+ (default '())))
+
+(define append-subid-ranges
+ (lambda args
+ (delete-duplicate-ranges
+ (apply append args))))
+
+(define (subids-extension-merge a b)
+ (subids-extension
+ (subgids (append-subid-ranges
+ (subids-extension-subgids a)
+ (subids-extension-subgids b)))
+ (subuids (append-subid-ranges
+ (subids-extension-subuids a)
+ (subids-extension-subuids b)))))
+
+(define subids-service-type
+ (service-type (name 'subids)
+ ;; Concatenate <subid-range> lists.
+ (compose (lambda (args)
+ (fold subids-extension-merge
+ (subids-extension)
+ args)))
+ (extend
+ (lambda (config extension)
+ (subids-configuration
+ (inherit config)
+ (subgids
+ (append-subid-ranges
+ (subids-configuration-subgids config)
+ (subids-extension-subgids extension)))
+ (subuids
+ (append-subid-ranges
+ (subids-configuration-subuids config)
+ (subids-extension-subuids extension))))))
+ (extensions
+ (list (service-extension activation-service-type
+ subids-activation)))
+ (default-value
+ (subids-configuration))
+ (description
+ "Ensure the specified sub UIDs and sub GIDs exist in
+/etc/subuid and /etc/subgid.")))
+
;;; shadow.scm ends here
diff --git a/gnu/tests/shadow.scm b/gnu/tests/shadow.scm
new file mode 100644
index 0000000000..1e755b5438
--- /dev/null
+++ b/gnu/tests/shadow.scm
@@ -0,0 +1,128 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2024 Giacomo Leidi <goodoldpaul@autistici.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu tests shadow)
+ #:use-module (gnu packages base)
+ #:use-module (gnu tests)
+ #:use-module (gnu services)
+ #:use-module (gnu system)
+ #:use-module (gnu system accounts)
+ #:use-module (gnu system shadow)
+ #:use-module (gnu system vm)
+ #:use-module (guix gexp)
+ #:export (%test-subids))
+
+
+(define %subids-os
+ (simple-operating-system
+ (simple-service
+ 'simple-subids
+ subids-service-type
+ (subids-extension
+ (subgids
+ (list
+ (subid-range
+ (name "alice"))
+ (subid-range
+ (name "bob")
+ (start 100700))))
+ (subuids
+ (list
+ (subid-range
+ (name "alice"))))))))
+
+(define (run-subids-test)
+ "Run IMAGE as an OCI backed Shepherd service, inside OS."
+
+ (define os
+ (marionette-operating-system
+
This message was truncated. Download the full message here.
G
G
Giacomo Leidi wrote on 21 Aug 00:14 +0200
[PATCH v3 1/3] accounts: Add /etc/subuid and /etc/subgid support.
(address . 72337@debbugs.gnu.org)(name . Giacomo Leidi)(address . goodoldpaul@autistici.org)
ea47c9ba31ab1700d10c518d8be25238586dec33.1724192097.git.goodoldpaul@autistici.org
This commit adds a new record type, <subid-entry> and serializers
and deserializers for it in (gnu build accounts). Each instance of this
record represents one line in either /etc/subuid or /etc/subgid. Since
Shadow uses the same representation for both files, it should be ok if
we do it as well.

This commit adds also <subid-range>, a user facing representation of
<subid-entry>. It is supposed to be usable directly in OS configurations.

* gnu/build/accounts.scm (subid-entry): New record;
(write-subgid): add serializer for subgids;
(write-subuid): add serializer for subuids;
(read-subgid): add serializer for subgids;
(read-subuid): add serializer for subuids.
* gnu/system/accounts.scm (subid-range): New record.
* test/accounts.scm: Test them.

Change-Id: I6b037e40e354c069bf556412bb5b626bd3ea1b2c
---
gnu/build/accounts.scm | 37 ++++++++++++++++++++++++---
gnu/system/accounts.scm | 17 +++++++++++++
tests/accounts.scm | 55 +++++++++++++++++++++++++++++++++++++++++
3 files changed, 106 insertions(+), 3 deletions(-)

Toggle diff (215 lines)
diff --git a/gnu/build/accounts.scm b/gnu/build/accounts.scm
index fa6f454b5e..ea8c69f205 100644
--- a/gnu/build/accounts.scm
+++ b/gnu/build/accounts.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019, 2021, 2023 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2024 Giacomo Leidi <goodoldpaul@autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -51,13 +52,23 @@ (define-module (gnu build accounts)
group-entry-gid
group-entry-members
+ subid-entry
+ subid-entry?
+ subid-entry-name
+ subid-entry-start
+ subid-entry-count
+
%password-lock-file
write-group
write-passwd
write-shadow
+ write-subgid
+ write-subuid
read-group
read-passwd
read-shadow
+ read-subgid
+ read-subuid
%id-min
%id-max
@@ -68,11 +79,12 @@ (define-module (gnu build accounts)
;;; Commentary:
;;;
-;;; This modules provides functionality equivalent to the C library's
+;;; This module provides functionality equivalent to the C library's
;;; <shadow.h>, <pwd.h>, and <grp.h> routines, as well as a subset of the
;;; functionality of the Shadow command-line tools. It can parse and write
-;;; /etc/passwd, /etc/shadow, and /etc/group. It can also take care of UID
-;;; and GID allocation in a way similar to what 'useradd' does.
+;;; /etc/passwd, /etc/shadow, /etc/group, /etc/subuid and /etc/subgid. It can
+;;; also take care of UID and GID allocation in a way similar to what 'useradd'
+;;; does. The same goes for sub UID and sub GID allocation.
;;;
;;; The benefit is twofold: less code is involved, and the ID allocation
;;; strategy and state preservation is made explicit.
@@ -225,6 +237,17 @@ (define-database-entry <group-entry> ;<grp.h>
(serialization list->comma-separated comma-separated->list)
(default '())))
+(define-database-entry <subid-entry> ;<subid.h>
+ subid-entry make-subid-entry
+ subid-entry?
+ (serialization #\: subid-entry->string string->subid-entry)
+
+ (name subid-entry-name)
+ (start subid-entry-start
+ (serialization number->string string->number))
+ (count subid-entry-count
+ (serialization number->string string->number)))
+
(define %password-lock-file
;; The password database lock file used by libc's 'lckpwdf'. Users should
;; grab this lock with 'with-file-lock' when they access the databases.
@@ -265,6 +288,10 @@ (define write-shadow
(database-writer "/etc/shadow" #o600 shadow-entry->string))
(define write-group
(database-writer "/etc/group" #o644 group-entry->string))
+(define write-subuid
+ (database-writer "/etc/subuid" #o644 subid-entry->string))
+(define write-subgid
+ (database-writer "/etc/subgid" #o644 subid-entry->string))
(define (database-reader file string->entry)
(lambda* (#:optional (file-or-port file))
@@ -287,6 +314,10 @@ (define read-shadow
(database-reader "/etc/shadow" string->shadow-entry))
(define read-group
(database-reader "/etc/group" string->group-entry))
+(define read-subuid
+ (database-reader "/etc/subuid" string->subid-entry))
+(define read-subgid
+ (database-reader "/etc/subgid" string->subid-entry))
;;;
diff --git a/gnu/system/accounts.scm b/gnu/system/accounts.scm
index 586cff1842..9a006c188d 100644
--- a/gnu/system/accounts.scm
+++ b/gnu/system/accounts.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2024 Giacomo Leidi <goodoldpaul@autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -39,6 +40,12 @@ (define-module (gnu system accounts)
user-group-id
user-group-system?
+ subid-range
+ subid-range?
+ subid-range-name
+ subid-range-start
+ subid-range-count
+
sexp->user-account
sexp->user-group
@@ -85,6 +92,16 @@ (define-record-type* <user-group>
(system? user-group-system? ; Boolean
(default #f)))
+(define-record-type* <subid-range>
+ subid-range make-subid-range
+ subid-range?
+ (name subid-range-name)
+ (start subid-range-start (default #f)) ; number
+ (count subid-range-count ; number
+ ; from find_new_sub_gids.c and
+ ; find_new_sub_uids.c
+ (default 65536)))
+
(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 78136390bb..4944c22f49 100644
--- a/tests/accounts.scm
+++ b/tests/accounts.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2024 Giacomo Leidi <goodoldpaul@autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -41,6 +42,16 @@ (define %shadow-sample
charlie:" (crypt "hey!" "$6$abc") ":17169::::::
nobody:!:0::::::\n"))
+(define %subuid-sample
+ "\
+root:100000:300
+ada:100300:300\n")
+
+(define %subgid-sample
+ "\
+root:100000:600
+ada:100600:300\n")
+
(test-begin "accounts")
@@ -135,6 +146,50 @@ (define %shadow-sample
read-shadow)
port))))
+(test-equal "write-subuid"
+ %subuid-sample
+ (call-with-output-string
+ (lambda (port)
+ (write-subuid (list (subid-entry
+ (name "root")
+ (start 100000)
+ (count 300))
+ (subid-entry
+ (name "ada")
+ (start 100300)
+ (count 300)))
+ port))))
+
+(test-equal "read-subuid + write-subuid"
+ %subuid-sample
+ (call-with-output-string
+ (lambda (port)
+ (write-subuid (call-with-input-string %subuid-sample
+ read-subuid)
+ port))))
+
+(test-equal "write-subgid"
+ %subgid-sample
+ (call-with-output-string
+ (lambda (port)
+ (write-subgid (list (subid-entry
+ (name "root")
+ (start 100000)
+ (count 600))
+ (subid-entry
+ (name "ada")
+ (start 100600)
+ (count 300)))
+ port))))
+
+(test-equal "read-subgid + write-subgid"
+ %subgid-sample
+ (call-with-output-string
+ (lambda (port)
+ (write-subgid (call-with-input-string %subgid-sample
+ read-subgid)
+ port))))
+
(define allocate-groups (@@ (gnu build accounts) allocate-groups))
(define allocate-passwd (@@ (gnu build accounts) allocate-passwd))

base-commit: 00245fdcd4909d7e6b20fe88f5d089717115adc1
--
2.45.2
L
L
Ludovic Courtès wrote on 4 Sep 22:34 +0200
Re: bug#72337: Add /etc/subuid and /etc/subgid support
(name . Giacomo Leidi)(address . goodoldpaul@autistici.org)(address . 72337@debbugs.gnu.org)
87jzfrb1ke.fsf_-_@gnu.org
Hello,

Giacomo Leidi <goodoldpaul@autistici.org> skribis:

Toggle quote (19 lines)
> This commit adds a new record type, <subid-entry> and serializers
> and deserializers for it in (gnu build accounts). Each instance of this
> record represents one line in either /etc/subuid or /etc/subgid. Since
> Shadow uses the same representation for both files, it should be ok if
> we do it as well.
>
> This commit adds also <subid-range>, a user facing representation of
> <subid-entry>. It is supposed to be usable directly in OS configurations.
>
> * gnu/build/accounts.scm (subid-entry): New record;
> (write-subgid): add serializer for subgids;
> (write-subuid): add serializer for subuids;
> (read-subgid): add serializer for subgids;
> (read-subuid): add serializer for subuids.
> * gnu/system/accounts.scm (subid-range): New record.
> * test/accounts.scm: Test them.
>
> Change-Id: I6b037e40e354c069bf556412bb5b626bd3ea1b2c

LGTM!
L
L
Ludovic Courtès wrote on 4 Sep 23:00 +0200
(name . Giacomo Leidi)(address . goodoldpaul@autistici.org)(address . 72337@debbugs.gnu.org)
878qw7b0c5.fsf_-_@gnu.org
Giacomo Leidi <goodoldpaul@autistici.org> skribis:

Toggle quote (22 lines)
> * 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

Woow, neat! It didn’t occur to me that we’d need a proper subid
allocation mechanism as well.

Toggle quote (7 lines)
> +(define (list-set lst el k)
> + (if (>= k (length lst))
> + `(,@lst ,el)
> + `(,@(list-head lst k)
> + ,el
> + ,@(list-tail lst k))))

‘length’, ‘list-ref’, and thus ‘list-set’ are linear in the size of the
list so it’s something we should avoid, unless we know that the lists
we’re dealing with are always going to be small.

Toggle quote (6 lines)
> +;; 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)

[...]

Toggle quote (4 lines)
> +(define (sub-id? id)
> + (and (>= id %sub-id-min)
> + (< id %sub-id-max)))

s/sub-/subordinate-/

Toggle quote (6 lines)
> +(define (subid-range-fits? r interval-start interval-end)
> + (and (<= interval-start
> + (subid-range-start r))
> + (<= (subid-range-end r)
> + interval-end)))

Maybe: (within-subordinate-id-range? start end range) ?

Also, shouldn’t the first <= be >= ?

Please add docstrings for top-level procedures.

Toggle quote (5 lines)
> +(define (subid-range-fits-between? r a b)
> + (subid-range-fits? r
> + (+ (subid-range-start a) 1)
> + (- (subid-range-end b) 1)))

Maybe: (containing-subordinate-id-range? range a b) ?

Toggle quote (2 lines)
> +(define (insert-subid-range range lst)

We definitely need a docstring, I’m not sure what this is supposed to
do. :-)

Toggle quote (10 lines)
> + (unless (and (sub-id? range-start)
> + (sub-id? range-end))
> + (raise
> + (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 %sub-id-max) ", min is "
> + (number->string %sub-id-min) "."))))

There are two issues: first we need ‘raise’ from (srfi srfi-34), not
from (guile), since the latter has nothing to do with exceptions.

Second, ‘raise’ takes a SRFI-35 “error condition” (essentially a
record), not a string.

But my suggestion here would be to define specific error conditions,
like:

(define-condition-type &subordinate-id-error &error)
(define-condition-type &subordinate-id-range-error &subordinate-id-error
(id subordinate-id-range-error-id))

The latter is what we’d use here.

This procedure uses lists a lot, which should probably be avoided as I
wrote above. Perhaps a vlist would do, or perhaps a vhash, or a vector.

The procedure is also very long; I wonder if it could be further split
and/or share code with the existing allocation-related code.

Toggle quote (4 lines)
> + (test-error "allocate-subids with interleaving, impossible interleaving"
> + "error"
> + ;; Make sure it's impossible to explicitly request impossible allocations

Instead of ‘test-error’, which is currently kinda broken IIRC, I’d
suggest a more explicit approach:

(test-assert …
(guard (c ((whatever-error? c) #t))
…
#f))

Thanks,
Ludo’.
L
L
Ludovic Courtès wrote on 4 Sep 23:20 +0200
(name . Giacomo Leidi)(address . goodoldpaul@autistici.org)
87zfon9kvt.fsf_-_@gnu.org
Giacomo Leidi <goodoldpaul@autistici.org> skribis:

Toggle quote (24 lines)
> This commit adds a Guix System service to handle allocation of subuid
> and subgid requests. Users that don't care can just add themselves as a
> subid-range and don't need to specify anything but their user name.
> Users that care about specific ranges, such as possibly LXD, can specify
> a start and a count.
>
> * doc/guix.texi: Document the new service.
> * gnu/build/activation.scm (activate-subuids+subgids): New variable.
> * gnu/local.mk: Add gnu/tests/shadow.scm.
> * gnu/system/accounts.scm (sexp->subid-range): New variable.
> * gnu/system/shadow.scm (%root-subid): New variable;
> (subids-configuration): new record;
> (subid-range->gexp): new variable;
> (assert-valid-subids): new variable;
> (delete-duplicate-ranges): new variable;
> (subids-activation): new variable;
> (subids-extension): new record;
> (append-subid-ranges): new variable;
> (subids-extension-merge): new variable;
> (subids-service-type): new variable.
> * gnu/tests/shadow.scm (subids): New system test.
>
> Change-Id: I3755e1c75771220c74fe8ae5de1a7d90f2376635

Nice.

Toggle quote (5 lines)
> +The @code{(gnu system shadow)} module exposes the
> +@code{subids-service-type}, its configuration record
> +@code{subids-configuration} and its extension record
> +@code{subids-extension}.

I think this section should start by defining briefly what a
“subordinate ID” is, with a cross-reference to a primary source for that
(unfortunately glibc’s manual has nothing about it, so that’d be Linux
man pages I guess), and by giving an idea of what it’s used for.

It should use “subuid” and “subgid” only after it has introduced them as
abbreviations of “subordinate UID”.

Toggle quote (2 lines)
> +for the root account to both @code{/etc/subuid} and @code{/etc/subgid}, possibly

s/@code/@file/

Toggle quote (7 lines)
> +(define %sub-id-min
> + (@@ (gnu build accounts) %sub-id-min))
> +(define %sub-id-max
> + (@@ (gnu build accounts) %sub-id-max))
> +(define %sub-id-count
> + (@@ (gnu build accounts) %sub-id-count))

Use single ‘@’ or, better yet, #:use-module the thing.

Toggle quote (9 lines)
> +(define (assert-valid-subids ranges)
> + (cond ((>= (fold + 0 (map subid-range-count ranges))
> + (- %sub-id-max %sub-id-min -1))
> + (raise
> + (string-append
> + "The configured ranges are more than the "
> + (number->string
> + (- %sub-id-max %sub-id-min -1)) " max allowed.")))

Same comment as before regarding ‘raise’.

In this case, you could do: (raise (formatted-message (G_ …) …)).
This is done elsewhere in the code.

Toggle quote (14 lines)
> + (define slurp
> + (lambda args
> + (let* ((port (apply open-pipe* OPEN_READ args))
> + (output (read-lines port))
> + (status (close-pipe port)))
> + output)))
> + (let* ((response1 (slurp
> + ,(string-append #$coreutils "/bin/cat")
> + "/etc/subgid"))
> + (response2 (slurp
> + ,(string-append #$coreutils "/bin/cat")
> + "/etc/subuid")))
> + (list (string-join response1 "\n") (string-join response2 "\n"))))

Instead of running ‘cat’, I would suggest using:

(call-with-input-file "/etc/subuid" get-string-all)

or similar; it’s much simpler.

Also, it would be nice if the test could actually exercise subordinate
IDs, with ‘newuidmap’ or some such. Is that within reach?

Thanks,
Ludo’.
P
P
paul wrote on 7 Sep 22:44 +0200
(name . Ludovic Courtès)(address . ludo@gnu.org)
80b94cc3-bcb3-e5ab-1f2a-2731129874af@autistici.org
Hi Ludo’ ,

I'm sending an updated v4 patchset that should address most your
comments. One point I'm not sure about is still how to use newuidmap.
I've added a smoke test checking the content of /proc/self/uid_map
inside a podman unshare command. I'm not sure that is sufficient but for
a full Guile implementation I would wait for another issue if you agree.
I still have to find a reliable smoke test. This is something I've been
trying, without success so far :( .

(use-modules (ice-9 popen)
             ;(ice-9 rdelim)
             )


(define pid (primitive-fork))

(if (= 0 pid)
    (let ((port (pk 'port (open-output-pipe "bash"))))
      (sleep 1)
      (display "whoami\n" port)
      (display "cat /proc/self/uid_map\n" port)
      (display "cat /proc/self/gid_map\n" port)
      (if (not (eqv? 0 (status:exit-val (close-pipe port))))
          (error "Cannot run command")))
    (begin
      (system* "newuidmap" (number->string pid) "paul" "165536" "65536")))



Thank you for all your help in polishing this service,


giacomo
G
G
Giacomo Leidi wrote on 7 Sep 22:51 +0200
[PATCH v4 1/3] accounts: Add /etc/subuid and /etc/subgid support.
(address . 72337@debbugs.gnu.org)(name . Giacomo Leidi)(address . goodoldpaul@autistici.org)
8737329a065c5436643c6e5e7d52ec760f069725.1725742309.git.goodoldpaul@autistici.org
This commit adds a new record type, <subid-entry> and serializers
and deserializers for it in (gnu build accounts). Each instance of this
record represents one line in either /etc/subuid or /etc/subgid. Since
Shadow uses the same representation for both files, it should be ok if
we do it as well.

This commit adds also <subid-range>, a user facing representation of
<subid-entry>. It is supposed to be usable directly in OS configurations.

* gnu/build/accounts.scm (subid-entry): New record;
(write-subgid): add serializer for subgids;
(write-subuid): add serializer for subuids;
(read-subgid): add serializer for subgids;
(read-subuid): add serializer for subuids.
* gnu/system/accounts.scm (subid-range): New record.
* test/accounts.scm: Test them.

Change-Id: I6b037e40e354c069bf556412bb5b626bd3ea1b2c
Signed-off-by: Giacomo Leidi <goodoldpaul@autistici.org>
---
gnu/build/accounts.scm | 37 ++++++++++++++++++++++++---
gnu/system/accounts.scm | 17 +++++++++++++
tests/accounts.scm | 55 +++++++++++++++++++++++++++++++++++++++++
3 files changed, 106 insertions(+), 3 deletions(-)

Toggle diff (215 lines)
diff --git a/gnu/build/accounts.scm b/gnu/build/accounts.scm
index fa6f454b5e..ea8c69f205 100644
--- a/gnu/build/accounts.scm
+++ b/gnu/build/accounts.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019, 2021, 2023 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2024 Giacomo Leidi <goodoldpaul@autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -51,13 +52,23 @@ (define-module (gnu build accounts)
group-entry-gid
group-entry-members
+ subid-entry
+ subid-entry?
+ subid-entry-name
+ subid-entry-start
+ subid-entry-count
+
%password-lock-file
write-group
write-passwd
write-shadow
+ write-subgid
+ write-subuid
read-group
read-passwd
read-shadow
+ read-subgid
+ read-subuid
%id-min
%id-max
@@ -68,11 +79,12 @@ (define-module (gnu build accounts)
;;; Commentary:
;;;
-;;; This modules provides functionality equivalent to the C library's
+;;; This module provides functionality equivalent to the C library's
;;; <shadow.h>, <pwd.h>, and <grp.h> routines, as well as a subset of the
;;; functionality of the Shadow command-line tools. It can parse and write
-;;; /etc/passwd, /etc/shadow, and /etc/group. It can also take care of UID
-;;; and GID allocation in a way similar to what 'useradd' does.
+;;; /etc/passwd, /etc/shadow, /etc/group, /etc/subuid and /etc/subgid. It can
+;;; also take care of UID and GID allocation in a way similar to what 'useradd'
+;;; does. The same goes for sub UID and sub GID allocation.
;;;
;;; The benefit is twofold: less code is involved, and the ID allocation
;;; strategy and state preservation is made explicit.
@@ -225,6 +237,17 @@ (define-database-entry <group-entry> ;<grp.h>
(serialization list->comma-separated comma-separated->list)
(default '())))
+(define-database-entry <subid-entry> ;<subid.h>
+ subid-entry make-subid-entry
+ subid-entry?
+ (serialization #\: subid-entry->string string->subid-entry)
+
+ (name subid-entry-name)
+ (start subid-entry-start
+ (serialization number->string string->number))
+ (count subid-entry-count
+ (serialization number->string string->number)))
+
(define %password-lock-file
;; The password database lock file used by libc's 'lckpwdf'. Users should
;; grab this lock with 'with-file-lock' when they access the databases.
@@ -265,6 +288,10 @@ (define write-shadow
(database-writer "/etc/shadow" #o600 shadow-entry->string))
(define write-group
(database-writer "/etc/group" #o644 group-entry->string))
+(define write-subuid
+ (database-writer "/etc/subuid" #o644 subid-entry->string))
+(define write-subgid
+ (database-writer "/etc/subgid" #o644 subid-entry->string))
(define (database-reader file string->entry)
(lambda* (#:optional (file-or-port file))
@@ -287,6 +314,10 @@ (define read-shadow
(database-reader "/etc/shadow" string->shadow-entry))
(define read-group
(database-reader "/etc/group" string->group-entry))
+(define read-subuid
+ (database-reader "/etc/subuid" string->subid-entry))
+(define read-subgid
+ (database-reader "/etc/subgid" string->subid-entry))
;;;
diff --git a/gnu/system/accounts.scm b/gnu/system/accounts.scm
index 586cff1842..9a006c188d 100644
--- a/gnu/system/accounts.scm
+++ b/gnu/system/accounts.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2024 Giacomo Leidi <goodoldpaul@autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -39,6 +40,12 @@ (define-module (gnu system accounts)
user-group-id
user-group-system?
+ subid-range
+ subid-range?
+ subid-range-name
+ subid-range-start
+ subid-range-count
+
sexp->user-account
sexp->user-group
@@ -85,6 +92,16 @@ (define-record-type* <user-group>
(system? user-group-system? ; Boolean
(default #f)))
+(define-record-type* <subid-range>
+ subid-range make-subid-range
+ subid-range?
+ (name subid-range-name)
+ (start subid-range-start (default #f)) ; number
+ (count subid-range-count ; number
+ ; from find_new_sub_gids.c and
+ ; find_new_sub_uids.c
+ (default 65536)))
+
(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 78136390bb..4944c22f49 100644
--- a/tests/accounts.scm
+++ b/tests/accounts.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2024 Giacomo Leidi <goodoldpaul@autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -41,6 +42,16 @@ (define %shadow-sample
charlie:" (crypt "hey!" "$6$abc") ":17169::::::
nobody:!:0::::::\n"))
+(define %subuid-sample
+ "\
+root:100000:300
+ada:100300:300\n")
+
+(define %subgid-sample
+ "\
+root:100000:600
+ada:100600:300\n")
+
(test-begin "accounts")
@@ -135,6 +146,50 @@ (define %shadow-sample
read-shadow)
port))))
+(test-equal "write-subuid"
+ %subuid-sample
+ (call-with-output-string
+ (lambda (port)
+ (write-subuid (list (subid-entry
+ (name "root")
+ (start 100000)
+ (count 300))
+ (subid-entry
+ (name "ada")
+ (start 100300)
+ (count 300)))
+ port))))
+
+(test-equal "read-subuid + write-subuid"
+ %subuid-sample
+ (call-with-output-string
+ (lambda (port)
+ (write-subuid (call-with-input-string %subuid-sample
+ read-subuid)
+ port))))
+
+(test-equal "write-subgid"
+ %subgid-sample
+ (call-with-output-string
+ (lambda (port)
+ (write-subgid (list (subid-entry
+ (name "root")
+ (start 100000)
+ (count 600))
+ (subid-entry
+ (name "ada")
+ (start 100600)
+ (count 300)))
+ port))))
+
+(test-equal "read-subgid + write-subgid"
+ %subgid-sample
+ (call-with-output-string
+ (lambda (port)
+ (write-subgid (call-with-input-string %subgid-sample
+ read-subgid)
+ port))))
+
(define allocate-groups (@@ (gnu build accounts) allocate-groups))
(define allocate-passwd (@@ (gnu build accounts) allocate-passwd))

base-commit: 4ba9f3e0f1484524f91ca1f7ec3a4ce7cb8873ff
--
2.45.2
G
G
Giacomo Leidi wrote on 7 Sep 22:51 +0200
[PATCH v4 2/3] account: Add /etc/subid and /etc/subgid allocation logic.
(address . 72337@debbugs.gnu.org)(name . Giacomo Leidi)(address . goodoldpaul@autistici.org)
2771695a2527240c89c0ba6879aeda0d4ab840ab.1725742309.git.goodoldpaul@autistici.org
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 <goodoldpaul@autistici.org>
---
gnu/build/accounts.scm | 187 +++++++++++++++++++++++++++++++++++++++-
gnu/system/accounts.scm | 30 +++++++
tests/accounts.scm | 152 ++++++++++++++++++++++++++++++++
3 files changed, 368 insertions(+), 1 deletion(-)

Toggle diff (472 lines)
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 <allocation> 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 <subid-range>. 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* <subid-range>
; 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)))
+
This message was truncated. Download the full message here.
G
G
Giacomo Leidi wrote on 7 Sep 22:51 +0200
[PATCH v4 3/3] system: Add /etc/subuid and /etc/subgid support.
(address . 72337@debbugs.gnu.org)(name . Giacomo Leidi)(address . goodoldpaul@autistici.org)
479d5a6eb25e4a4156fa04774ad8800f38ea08ec.1725742309.git.goodoldpaul@autistici.org
This commit adds a Guix System service to handle allocation of subuid
and subgid requests. Users that don't care can just add themselves as a
subid-range and don't need to specify anything but their user name.
Users that care about specific ranges, such as possibly LXD, can specify
a start and a count.

* doc/guix.texi: Document the new service.
* gnu/build/activation.scm (activate-subuids+subgids): New variable.
* gnu/local.mk: Add gnu/tests/shadow.scm.
* gnu/system/accounts.scm (sexp->subid-range): New variable.
* gnu/system/shadow.scm (%root-subid): New variable;
(subids-configuration): new record;
(subid-range->gexp): new variable;
(assert-valid-subids): new variable;
(delete-duplicate-ranges): new variable;
(subids-activation): new variable;
(subids-extension): new record;
(append-subid-ranges): new variable;
(subids-extension-merge): new variable;
(subids-service-type): new variable.
* gnu/tests/shadow.scm (subids): New system test.

Change-Id: I3755e1c75771220c74fe8ae5de1a7d90f2376635
Signed-off-by: Giacomo Leidi <goodoldpaul@autistici.org>
---
doc/guix.texi | 180 +++++++++++++++++++++++++++++++++
gnu/build/activation.scm | 19 ++++
gnu/local.mk | 1 +
gnu/system/accounts.scm | 10 ++
gnu/system/shadow.scm | 211 ++++++++++++++++++++++++++++++++++++++-
gnu/tests/shadow.scm | 180 +++++++++++++++++++++++++++++++++
6 files changed, 599 insertions(+), 2 deletions(-)
create mode 100644 gnu/tests/shadow.scm

Toggle diff (538 lines)
diff --git a/doc/guix.texi b/doc/guix.texi
index 981ffb8c58..16fd415b32 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -41683,6 +41683,186 @@ Miscellaneous Services
@end deftp
+@c %end of fragment
+
+@cindex Subids
+@subsubheading Subid Service
+
+Among the virtualization facilities implemented by the Linux kernel, the is the
+concept of subordinate IDs. Subordinate IDs allow for mapping user and group
+IDs inside process namespaces to user and group IDs of the host system.
+Subordinate user ID ranges (subids) allow to map virtual user IDs inside
+containers to the user ID of an unprivileged user of the host system.
+Subordinate group ID ranges (subgids), instead map virtual group IDs to the
+group ID of an unprivileged user on the host system. You can access
+@code{subuid(5)} and @code{subgid(5)} Linux man pages for more details.
+
+The @code{(gnu system shadow)} module exposes the
+@code{subids-service-type}, its configuration record
+@code{subids-configuration} and its extension record
+@code{subids-extension}.
+
+With @code{subids-service-type}, subuids and subgids ranges can be reserved for
+users that desire so:
+
+@lisp
+(use-modules (gnu system shadow) ;for 'subids-service-type'
+ (gnu system accounts) ;for 'subid-range'
+ @dots{})
+
+(operating-system
+ ;; @dots{}
+ (services
+ (list
+ (simple-service 'alice-bob-subids
+ subids-service-type
+ (subids-extension
+ (subgids
+ (list
+ (subid-range (name "alice"))))
+ (subuids
+ (list
+ (subid-range (name "alice"))
+ (subid-range (name "bob")
+ (start 100700)))))))))
+@end lisp
+
+Users (definitely other services), usually, are supposed to extend the service
+instead of adding subids directly to @code{subids-configuration}, unless the
+want to change the default behavior for root. With default settings the
+@code{subids-service-type} adds, if it's not already there, a configuration
+for the root account to both @file{/etc/subuid} and @file{/etc/subgid}, possibly
+starting at the minimum possible subid. Otherwise the root subuids and subgids
+ranges are fitted wherever possible.
+
+The above configuration will yield the following:
+
+@example
+# cat /etc/subgid
+root:100000:65536
+alice:165536:65536
+# cat /etc/subuid
+root:100000:700
+bob:100700:65536
+alice:166236:65536
+@end example
+
+@c %start of fragment
+
+@deftp {Data Type} subids-configuration
+
+With default settings the
+@code{subids-service-type} adds, if it's not already there, a configuration
+for the root account to both @file{/etc/subuid} and @file{/etc/subgid}, possibly
+starting at the minimum possible subid. To disable the default behavior and
+provide your own definition for the root subid ranges you can set to @code{#f}
+the @code{add-root?} field:
+
+@lisp
+(use-modules (gnu system shadow) ;for 'subids-service-type'
+ (gnu system accounts) ;for 'subid-range'
+ @dots{})
+
+(operating-system
+ ;; @dots{}
+ (services
+ (list
+ (service subids-service-type
+ (subids-configuration
+ (add-root? #f)
+ (subgids
+ (subid-range (name "root")
+ (start 120000)
+ (count 100)))
+ (subuids
+ (subid-range (name "root")
+ (start 120000)
+ (count 100)))))
+ (simple-service 'alice-bob-subids
+ subids-service-type
+ (subids-extension
+ (subgids
+ (list
+ (subid-range (name "alice"))))
+ (subuids
+ (list
+ (subid-range (name "alice"))
+ (subid-range (name "bob")
+ (start 100700)))))))))
+@end lisp
+
+Available @code{subids-configuration} fields are:
+
+@table @asis
+@item @code{add-root?} (default: @code{#t}) (type: boolean)
+Whether to automatically configure subuids and subgids for root.
+
+@item @code{subgids} (default: @code{'()}) (type: list-of-subid-ranges)
+The list of @code{subid-range}s that will be serialized to @code{/etc/subgid}.
+If a range doesn't specify a start it will be fitted based on its number of
+requrested subids. If a range doesn't specify a count the default size
+of 65536 will be assumed.
+
+@item @code{subuids} (default: @code{'()}) (type: list-of-subid-ranges)
+The list of @code{subid-range}s that will be serialized to @code{/etc/subuid}.
+If a range doesn't specify a start it will be fitted based on its number of
+requrested subids. If a range doesn't specify a count the default size
+of 65536 will be assumed.
+
+@end table
+
+@end deftp
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} subids-extension
+
+Available @code{subids-extension} fields are:
+
+@table @asis
+
+@item @code{subgids} (default: @code{'()}) (type: list-of-subid-ranges)
+The list of @code{subid-range}s that will be appended to
+@code{subids-configuration-subgids}. Entries with the same name are deduplicated
+upon merging.
+
+@item @code{subuids} (default: @code{'()}) (type: list-of-subid-ranges)
+The list of @code{subid-range}s that will be appended to
+@code{subids-configuration-subuids}. Entries with the same name are deduplicated
+upon merging.
+
+@end table
+
+@end deftp
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} subid-range
+
+The @code{subid-range} record is defined at @code{(gnu system accounts)}.
+Available fields are:
+
+@table @asis
+
+@item @code{name} (type: string)
+The name of the user or group that will own this range.
+
+@item @code{start} (default: @code{#f}) (type: integer)
+The first requested subid. When false the first available subid with enough
+contiguous subids will be assigned.
+
+@item @code{count} (default: @code{#f}) (type: integer)
+The number of total allocated subids. When #f the default of 65536 will be
+assumed .
+
+@end table
+
+@end deftp
+
@c %end of fragment
@node Privileged Programs
diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm
index d1a2876a96..5236fbb403 100644
--- a/gnu/build/activation.scm
+++ b/gnu/build/activation.scm
@@ -10,6 +10,7 @@
;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
;;; Copyright © 2022 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2024 Nicolas Graves <ngraves@ngraves.fr>
+;;; Copyright © 2024 Giacomo Leidi <goodoldpaul@autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -40,6 +41,7 @@ (define-module (gnu build activation)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:export (activate-users+groups
+ activate-subuids+subgids
activate-user-home
activate-etc
activate-privileged-programs
@@ -227,6 +229,23 @@ (define (activate-users+groups users groups)
(chmod directory #o555))
(duplicates (map user-account-home-directory system-accounts))))
+(define (activate-subuids+subgids subuids subgids)
+ "Make sure SUBUIDS (a list of subid range records) and SUBGIDS (a list of
+subid range records) are all available."
+
+ ;; Take same lock as Shadow while we read
+ ;; and write the databases. This ensures there's no race condition with
+ ;; other tools that might be accessing it at the same time.
+ (with-file-lock "/etc/subgid.lock"
+ (let-values (((subuid subgid)
+ (subuid+subgid-databases subuids subgids)))
+ (write-subgid subgid)))
+
+ (with-file-lock "/etc/subuid.lock"
+ (let-values (((subuid subgid)
+ (subuid+subgid-databases subuids subgids)))
+ (write-subuid subuid))))
+
(define (activate-user-home users)
"Create and populate the home directory of USERS, a list of tuples, unless
they already exist."
diff --git a/gnu/local.mk b/gnu/local.mk
index ed630041ff..b36873f28a 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -841,6 +841,7 @@ GNU_SYSTEM_MODULES = \
%D%/tests/samba.scm \
%D%/tests/security.scm \
%D%/tests/security-token.scm \
+ %D%/tests/shadow.scm \
%D%/tests/singularity.scm \
%D%/tests/ssh.scm \
%D%/tests/telephony.scm \
diff --git a/gnu/system/accounts.scm b/gnu/system/accounts.scm
index 1b88ca301f..f63d7f96bd 100644
--- a/gnu/system/accounts.scm
+++ b/gnu/system/accounts.scm
@@ -51,6 +51,7 @@ (define-module (gnu system accounts)
sexp->user-account
sexp->user-group
+ sexp->subid-range
default-shell))
@@ -159,3 +160,12 @@ (define (sexp->user-account sexp)
(create-home-directory? create-home-directory?)
(shell shell) (password password)
(system? system?)))))
+
+(define (sexp->subid-range sexp)
+ "Take SEXP, a tuple as returned by 'subid-range->gexp', and turn it into a
+subid-range record."
+ (match sexp
+ ((name start count)
+ (subid-range (name name)
+ (start start)
+ (count count)))))
diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm
index d9f13271d8..48eca2564f 100644
--- a/gnu/system/shadow.scm
+++ b/gnu/system/shadow.scm
@@ -4,6 +4,7 @@
;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2020, 2023 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2024 Giacomo Leidi <goodoldpaul@autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -28,6 +29,10 @@ (define-module (gnu system shadow)
#:use-module (guix modules)
#:use-module (guix sets)
#:use-module (guix ui)
+ #:use-module ((gnu build accounts)
+ #:select (%subordinate-id-count
+ %subordinate-id-max
+ %subordinate-id-min))
#:use-module (gnu system accounts)
#:use-module (gnu services)
#:use-module (gnu services shepherd)
@@ -77,7 +82,20 @@ (define-module (gnu system shadow)
%base-user-accounts
account-service-type
- account-service))
+ account-service
+
+ subids-configuration
+ subids-configuration?
+ subids-configuration-add-root?
+ subids-configuration-subgids
+ subids-configuration-subuids
+
+ subids-extension
+ subids-extension?
+ subids-extension-subgids
+ subids-extension-subuids
+
+ subids-service-type))
;;; Commentary:
;;;
@@ -380,7 +398,7 @@ (define (assert-valid-users/groups users groups)
;;;
-;;; Service.
+;;; Accounts Service.
;;;
(define (user-group->gexp group)
@@ -521,4 +539,193 @@ (define (account-service accounts+groups skeletons)
(service account-service-type
(append skeletons accounts+groups)))
+
+;;;
+;;; Subids Service.
+;;;
+
+(define* (%root-subid #:optional (start %subordinate-id-min) (count %subordinate-id-count))
+ (subid-range
+ (name "root")
+ (start start)
+ (count count)))
+
+(define-record-type* <subids-configuration>
+ subids-configuration make-subids-configuration
+ subids-configuration?
+ this-subids-configuration
+
+ (add-root? subids-configuration-add-root? ; boolean
+ (default #t))
+ (subgids subids-configuration-subgids ; list of <subid-range>
+ (default '()))
+ (subuids subids-configuration-subuids ; list of <subid-range>
+ (default '())))
+
+(define (subid-range->gexp range)
+ "Turn RANGE, a <subid-range> object, into a list-valued gexp suitable for
+'activate-subuids+subgids'."
+ (define count (subid-range-count range))
+ #~`(#$(subid-range-name range)
+ #$(subid-range-start range)
+ #$(if (and (number? count)
+ (> count 0))
+ count
+ %subordinate-id-count)))
+
+(define (assert-valid-subids ranges)
+ (cond ((>= (fold + 0 (map subid-range-count ranges))
+ (- %subordinate-id-max %subordinate-id-min -1))
+ (raise
+ (formatted-message
+ (G_
+ "The configured ranges are more than the ~a max allowed.")
+ (- %subordinate-id-max %subordinate-id-min -1))))
+ ((any (lambda (r)
+ (define start (subid-range-start r))
+ (and start
+ (< start %subordinate-id-min)))
+ ranges)
+ (raise
+ (formatted-message
+ (G_
+ "One subid-range starts before the minimum allowed sub id ~a.")
+ %subordinate-id-min)))
+ ((any (lambda (r)
+ (define end (subid-range-end r))
+ (and end
+ (> end %subordinate-id-max)))
+ ranges)
+ (raise
+ (formatted-message
+ (G_
+ "One subid-range ends after the maximum allowed sub id ~a.")
+ %subordinate-id-max)))
+ ((any (compose null? subid-range-name)
+ ranges)
+ (raise
+ (formatted-message
+ (G_
+ "One subid-range has a null name."))))
+ ((any (compose string-null? subid-range-name)
+ ranges)
+ (raise
+ (formatted-message
+ (G_
+ "One subid-range has a name equal to the empty string."))))
+ (else #t)))
+
+(define (delete-duplicate-ranges ranges)
+ (delete-duplicates ranges
+ (lambda args
+ (apply string=? (map subid-range-name ranges)))))
+
+(define (subids-activation config)
+ "Return a gexp that activates SUBUIDS+SUBGIDS, a list of <subid-range>
+objects."
+ (define (add-root-when-missing ranges)
+ (define sorted-ranges
+ (sort-list ranges subid-range-less))
+ (define root-missing?
+ (not
+ (find (lambda (r)
+ (string=? "root"
+ (subid-range-name r)))
+ sorted-ranges)))
+ (define first-start
+ (and (> (length sorted-ranges) 0)
+ (subid-range-start (first sorted-ranges))))
+ (define first-has-start?
+ (number? first-start))
+ (define root-start
+ (if first-has-start?
+ (and
+ (> first-start %subordinate-id-min)
+ %subordinate-id-min)
+ %subordinate-id-min))
+ (define root-count
+ (if first-has-start?
+ (- first-start %subordinate-id-min)
+ %subordinate-id-count))
+ (if (and root-missing?
+ (subids-configuration-add-root? config))
+ (append (list (%root-subid root-start root-count))
+ sorted-ranges)
+ sorted-ranges))
+
+ (define subuids
+ (delete-duplicate-ranges (subids-configuration-subuids config)))
+
+ (define subuids-specs
+ (map subid-range->gexp (add-root-when-missing subuids)))
+
+ (define subgids
+ (delete-duplicate-ranges (subids-configuration-subgids config)))
+
+ (define subgids-specs
+ (map subid-range->gexp (add-root-when-missing subgids)))
+
+ (assert-valid-subids subgids)
+ (assert-valid-subids subuids)
+
+ ;; Add subuids and subgids.
+ (with-imported-modules (source-module-closure '((gnu system accounts)))
+ #~(begin
+ (use-modules (gnu system accounts))
+
+ (activate-subuids+subgids (map sexp->subid-range (list #$@subuids-specs))
+ (map sexp->subid-range (list #$@subgids-specs))))))
+
+(define-record-type* <subids-extension>
+ subids-extension make-subids-extension
+ subids-extension?
+ this-subids-extension
+
+ (subgids subids-extension-subgids ; list of <subid-range>
+ (default '()))
+ (subuids subids-extension-subuids ; list of <subid-range>
+ (default '())))
+
+(define append-subid-ranges
+ (lambda args
+ (delete-duplicate-ranges
+ (apply append args))))
+
+(define (subids-extension-merge a b)
+ (subids-extension
+ (subgids (append-subid-ranges
+ (subids-extension-subgids a)
+ (subids-extension-subgids b)))
+ (subuids (append-subid-ranges
+ (subids-extension-subuids a)
+ (subids-extension-subuids b)))))
+
+(define subids-service-type
+ (service-type (name 'subids)
+ ;; Concatenate <subid-range> lists.
+ (compose (lambda (args)
+ (fold subids-extension-merge
+ (subids-extension)
+ args)))
+ (extend
+ (lambda (config extension)
+ (subids-configuration
+ (inherit config)
+ (subgids
+ (append-subid-ranges
+ (subids-configuration-subgids config)
+ (subids-extension-subgids extension)))
+ (subuids
+ (append-subid-ranges
+ (subids-configuration-subuids config)
+ (subids-extension-subuids extension))))))
+ (extensions
+ (list (service-extension activation-service-type
+ subids-activation)))
+ (default-value
+ (subids-configuration))
+ (description
+ "Ensure the specified sub UIDs and sub GIDs exist in
+/etc/subuid and /etc/subgid.")))
+
;;; shadow.scm ends here
diff --git a/gnu/tests/shadow.scm b/gnu/tests/shadow.scm
new file mode 100644
index 0000000000..849b7b8af0
--- /dev/null
+++ b/gnu/tests/shadow.scm
@@ -0,0 +1,180 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2024 Giacomo Leidi <goodoldpaul@autistici.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; w
This message was truncated. Download the full message here.
?
Your comment

Commenting via the web interface is currently disabled.

To comment on this conversation send an email to 72337@debbugs.gnu.org

To respond to this issue using the mumi CLI, first switch to it
mumi current 72337
Then, you may apply the latest patchset in this issue (with sign off)
mumi am -- -s
Or, compose a reply to this issue
mumi compose
Or, send patches to this issue
mumi send-email *.patch