projects/guix·blob python-team · refs

170 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;;; Commentary:
21;;;
22;;; Data structures representing user accounts and user groups. This is meant
23;;; to be used both on the host side and at run time--e.g., in activation
24;;; snippets.
25;;;
26;;; Code:
27
28(define-module (gnu system accounts)
29 #:use-module (guix records)
30 #:use-module (ice-9 match)
31 #:export (user-account
32 user-account?
33 user-account-name
34 user-account-password
35 user-account-uid
36 user-account-group
37 user-account-supplementary-groups
38 user-account-comment
39 user-account-home-directory
40 user-account-create-home-directory?
41 user-account-shell
42 user-account-system?
43
44 user-group
45 user-group?
46 user-group-name
47 user-group-password
48 user-group-id
49 user-group-system?
50
51 subid-range
52 subid-range?
53 subid-range-name
54 subid-range-start
55 subid-range-count
56 subid-range-end
57 subid-range-has-start?
58 subid-range-less
59
60 sexp->user-account
61 sexp->user-group
62 sexp->subid-range
63
64 default-shell))
65
66(define default-shell
67 ;; Default shell for user accounts (a string or string-valued gexp).
68 (make-parameter "/bin/sh"))
69
70(define-record-type* <user-account>
71 user-account make-user-account
72 user-account?
73 (name user-account-name)
74 (password user-account-password (default #f))
75 (uid user-account-uid (default #f))
76 (group user-account-group) ; number | string
77 (supplementary-groups user-account-supplementary-groups
78 (default '())) ; list of strings
79 (comment user-account-comment (default ""))
80 (home-directory user-account-home-directory (thunked)
81 (default (default-home-directory this-record)))
82 (create-home-directory? user-account-create-home-directory? ;Boolean
83 (default #t))
84 (shell user-account-shell ; gexp
85 (default (default-shell)))
86 (system? user-account-system? ; Boolean
87 (default #f)))
88
89(define-record-type* <user-group>
90 user-group make-user-group
91 user-group?
92 (name user-group-name)
93 (password user-group-password (default #f))
94 (id user-group-id (default #f))
95 (system? user-group-system? ; Boolean
96 (default #f)))
97
98(define-record-type* <subid-range>
99 subid-range make-subid-range
100 subid-range?
101 (name subid-range-name)
102 (start subid-range-start (default #f)) ; number
103 (count subid-range-count ; number
104 ; from find_new_sub_gids.c and
105 ; find_new_sub_uids.c
106 (default 65536)))
107
108(define (subid-range-end range)
109 "Returns the last subid referenced in RANGE."
110 (and
111 (subid-range-has-start? range)
112 (+ (subid-range-start range)
113 (subid-range-count range)
114 -1)))
115
116(define (subid-range-has-start? range)
117 "Returns #t when RANGE's start is a number."
118 (number? (subid-range-start range)))
119
120(define (subid-range-less a b)
121 "Returns #t when subid range A either starts before, or is more specific
122than B. When it is not possible to determine whether a range is more specific
123w.r.t. another range their names are compared alphabetically."
124 (define start-a (subid-range-start a))
125 (define start-b (subid-range-start b))
126 (cond ((and (not start-a) (not start-b))
127 (string< (subid-range-name a)
128 (subid-range-name b)))
129 ((and start-a start-b)
130 (< start-a start-b))
131 (else
132 (and start-a
133 (not start-b)))))
134
135(define (default-home-directory account)
136 "Return the default home directory for ACCOUNT."
137 (string-append "/home/" (user-account-name account)))
138
139(define (sexp->user-group sexp)
140 "Take SEXP, a tuple as returned by 'user-group->gexp', and turn it into a
141user-group record."
142 (match sexp
143 ((name password id system?)
144 (user-group (name name)
145 (password password)
146 (id id)
147 (system? system?)))))
148
149(define (sexp->user-account sexp)
150 "Take SEXP, a tuple as returned by 'user-account->gexp', and turn it into a
151user-account record."
152 (match sexp
153 ((name uid group supplementary-groups comment home-directory
154 create-home-directory? shell password system?)
155 (user-account (name name) (uid uid) (group group)
156 (supplementary-groups supplementary-groups)
157 (comment comment)
158 (home-directory home-directory)
159 (create-home-directory? create-home-directory?)
160 (shell shell) (password password)
161 (system? system?)))))
162
163(define (sexp->subid-range sexp)
164 "Take SEXP, a tuple as returned by 'subid-range->gexp', and turn it into a
165subid-range record."
166 (match sexp
167 ((name start count)
168 (subid-range (name name)
169 (start start)
170 (count count)))))