projects/guix·blob java-team · refs

171 lines · 5.9 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <[email protected]>
3;;; Copyright © 2024 Giacomo Leidi <[email protected]>
4;;;
5;;; This file is part of GNU Guix.
6;;;
7;;; GNU Guix is free software; you can redistribute it and/or modify it
8;;; under the terms of the GNU General Public License as published by
9;;; the Free Software Foundation; either version 3 of the License, or (at
10;;; your option) any later version.
11;;;
12;;; GNU Guix is distributed in the hope that it will be useful, but
13;;; WITHOUT ANY WARRANTY; without even the implied warranty of
14;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;;; GNU General Public License for more details.
16;;;
17;;; You should have received a copy of the GNU General Public License
18;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
19
20(define-module (gnu system accounts)
21 #:use-module (guix records)
22 #:use-module (ice-9 match)
23 #:export (user-account
24 user-account?
25 user-account-name
26 user-account-password
27 user-account-uid
28 user-account-group
29 user-account-supplementary-groups
30 user-account-comment
31 user-account-home-directory
32 user-account-create-home-directory?
33 user-account-shell
34 user-account-system?
35
36 user-group
37 user-group?
38 user-group-name
39 user-group-password
40 user-group-id
41 user-group-system?
42
43 subid-range
44 subid-range?
45 subid-range-name
46 subid-range-start
47 subid-range-count
48 subid-range-end
49 subid-range-has-start?
50 subid-range-less
51
52 sexp->user-account
53 sexp->user-group
54 sexp->subid-range
55
56 default-shell))
57
58
59;;; Commentary:
60;;;
61;;; Data structures representing user accounts and user groups. This is meant
62;;; to be used both on the host side and at run time--e.g., in activation
63;;; snippets.
64;;;
65;;; Code:
66
67(define default-shell
68 ;; Default shell for user accounts (a string or string-valued gexp).
69 (make-parameter "/bin/sh"))
70
71(define-record-type* <user-account>
72 user-account make-user-account
73 user-account?
74 (name user-account-name)
75 (password user-account-password (default #f))
76 (uid user-account-uid (default #f))
77 (group user-account-group) ; number | string
78 (supplementary-groups user-account-supplementary-groups
79 (default '())) ; list of strings
80 (comment user-account-comment (default ""))
81 (home-directory user-account-home-directory (thunked)
82 (default (default-home-directory this-record)))
83 (create-home-directory? user-account-create-home-directory? ;Boolean
84 (default #t))
85 (shell user-account-shell ; gexp
86 (default (default-shell)))
87 (system? user-account-system? ; Boolean
88 (default #f)))
89
90(define-record-type* <user-group>
91 user-group make-user-group
92 user-group?
93 (name user-group-name)
94 (password user-group-password (default #f))
95 (id user-group-id (default #f))
96 (system? user-group-system? ; Boolean
97 (default #f)))
98
99(define-record-type* <subid-range>
100 subid-range make-subid-range
101 subid-range?
102 (name subid-range-name)
103 (start subid-range-start (default #f)) ; number
104 (count subid-range-count ; number
105 ; from find_new_sub_gids.c and
106 ; find_new_sub_uids.c
107 (default 65536)))
108
109(define (subid-range-end range)
110 "Returns the last subid referenced in RANGE."
111 (and
112 (subid-range-has-start? range)
113 (+ (subid-range-start range)
114 (subid-range-count range)
115 -1)))
116
117(define (subid-range-has-start? range)
118 "Returns #t when RANGE's start is a number."
119 (number? (subid-range-start range)))
120
121(define (subid-range-less a b)
122 "Returns #t when subid range A either starts before, or is more specific
123than B. When it is not possible to determine whether a range is more specific
124w.r.t. another range their names are compared alphabetically."
125 (define start-a (subid-range-start a))
126 (define start-b (subid-range-start b))
127 (cond ((and (not start-a) (not start-b))
128 (string< (subid-range-name a)
129 (subid-range-name b)))
130 ((and start-a start-b)
131 (< start-a start-b))
132 (else
133 (and start-a
134 (not start-b)))))
135
136(define (default-home-directory account)
137 "Return the default home directory for ACCOUNT."
138 (string-append "/home/" (user-account-name account)))
139
140(define (sexp->user-group sexp)
141 "Take SEXP, a tuple as returned by 'user-group->gexp', and turn it into a
142user-group record."
143 (match sexp
144 ((name password id system?)
145 (user-group (name name)
146 (password password)
147 (id id)
148 (system? system?)))))
149
150(define (sexp->user-account sexp)
151 "Take SEXP, a tuple as returned by 'user-account->gexp', and turn it into a
152user-account record."
153 (match sexp
154 ((name uid group supplementary-groups comment home-directory
155 create-home-directory? shell password system?)
156 (user-account (name name) (uid uid) (group group)
157 (supplementary-groups supplementary-groups)
158 (comment comment)
159 (home-directory home-directory)
160 (create-home-directory? create-home-directory?)
161 (shell shell) (password password)
162 (system? system?)))))
163
164(define (sexp->subid-range sexp)
165 "Take SEXP, a tuple as returned by 'subid-range->gexp', and turn it into a
166subid-range record."
167 (match sexp
168 ((name start count)
169 (subid-range (name name)
170 (start start)
171 (count count)))))