projects/guix·blob python-team · refs

275 lines · 11.4 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2018 Mathieu Othacehe <[email protected]>
3;;; Copyright © 2019, 2022 Ludovic Courtès <[email protected]>
4;;; Copyright © 2020, 2024 Janneke Nieuwenhuizen <[email protected]>
5;;; Copyright © 2021 Tobias Geerinckx-Rice <[email protected]>
6;;; Copyright © 2021 Leo Famulari <[email protected]>
7;;; Copyright © 2023 Denys Nykula <[email protected]>
8;;; Copyright © 2025 Florian Pelz <[email protected]>
9;;; Copyright © 2025 Fredrik Salomonsson <[email protected]>
10;;;
11;;; This file is part of GNU Guix.
12;;;
13;;; GNU Guix is free software; you can redistribute it and/or modify it
14;;; under the terms of the GNU General Public License as published by
15;;; the Free Software Foundation; either version 3 of the License, or (at
16;;; your option) any later version.
17;;;
18;;; GNU Guix is distributed in the hope that it will be useful, but
19;;; WITHOUT ANY WARRANTY; without even the implied warranty of
20;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21;;; GNU General Public License for more details.
22;;;
23;;; You should have received a copy of the GNU General Public License
24;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
25
26(define-module (gnu installer services)
27 #:use-module (guix records)
28 #:use-module (guix read-print)
29 #:use-module (guix utils)
30 #:use-module (ice-9 match)
31 #:use-module (srfi srfi-1)
32 #:export (system-service?
33 system-service-name
34 system-service-type
35 system-service-recommended?
36 system-service-snippet
37 system-service-packages
38
39 desktop-system-service?
40 system-service-none
41
42 %system-services
43 system-services->configuration))
44
45(define-syntax-rule (G_ str)
46 ;; In this file, translatable strings are annotated with 'G_' so xgettext
47 ;; catches them, but translation happens later on at run time.
48 str)
49
50(define-record-type* <system-service>
51 system-service make-system-service
52 system-service?
53 (name system-service-name) ;string
54 (type system-service-type) ;'desktop|'networking|…
55 (recommended? system-service-recommended? ;Boolean
56 (default #f))
57 (snippet system-service-snippet ;list of sexps
58 (default '()))
59 (packages system-service-packages ;list of sexps
60 (default '())))
61
62(define system-service-none
63 (system-service
64 (name (G_ "None"))
65 (type 'network-management)
66 (snippet '())))
67
68(define (%system-services)
69 (let-syntax ((desktop-environment (syntax-rules ()
70 ((_ fields ...)
71 (system-service
72 (type 'desktop)
73 fields ...)))))
74 (list
75 ;; This is the list of desktop environments supported as services.
76 (desktop-environment
77 (name "GNOME")
78 (snippet '((service gnome-desktop-service-type))))
79 (desktop-environment
80 (name "Xfce")
81 (snippet '((service xfce-desktop-service-type))))
82 (desktop-environment
83 (name "MATE")
84 (snippet '((service mate-desktop-service-type))))
85 (desktop-environment
86 (name "KDE Plasma")
87 (snippet '((service plasma-desktop-service-type))))
88 (desktop-environment
89 (name "Icewm")
90 (packages '((specification->package "icewm"))))
91 (desktop-environment
92 (name "Openbox")
93 (packages '((specification->package "openbox"))))
94 (desktop-environment
95 (name "awesome")
96 (packages '((specification->package "awesome"))))
97 (desktop-environment
98 (name "i3")
99 (packages (map (lambda (package)
100 `(specification->package ,package))
101 '("i3-wm" "i3status" "dmenu" "st"))))
102 (desktop-environment
103 (name "ratpoison")
104 (packages '((specification->package "ratpoison")
105 (specification->package "xterm"))))
106 (desktop-environment
107 (name "Emacs EXWM")
108 (packages '((specification->package "emacs")
109 (specification->package "emacs-exwm")
110 (specification->package "emacs-desktop-environment"))))
111 (desktop-environment
112 (name "Sway")
113 (packages (map (lambda (package)
114 `(specification->package ,package))
115 '("sway" "wmenu" "foot"))))
116
117 ;; Networking.
118 (system-service
119 (name (G_ "OpenSSH secure shell daemon (sshd)"))
120 (type 'networking)
121 (snippet `(,(vertical-space 1)
122 ,(comment
123 (G_ "\
124;; To configure OpenSSH, pass an 'openssh-configuration'
125;; record as a second argument to 'service' below.\n"))
126 ,(if (target-hurd?)
127 '(service openssh-service-type
128 (openssh-configuration
129 (openssh openssh-sans-x)))
130 '(service openssh-service-type)))))
131 (system-service
132 (name (G_ "Tor anonymous network router"))
133 (type 'networking)
134 (snippet '((service tor-service-type))))
135
136 ;; Miscellaneous system administration services.
137 (system-service
138 (name (G_ "Network time service (NTP), to set the clock automatically"))
139 (type 'administration)
140 (recommended? (not (target-hurd?)))
141 (snippet '((service ntp-service-type))))
142 (system-service
143 (name (G_ "GPM mouse daemon, to use the mouse on the console"))
144 (type 'administration)
145 (snippet '((service gpm-service-type))))
146
147 ;; Network connectivity management.
148 (system-service
149 (name (G_ "NetworkManager network connection manager"))
150 (type 'network-management)
151 (snippet '((service network-manager-service-type)
152 (service wpa-supplicant-service-type))))
153 (system-service
154 (name (G_ "Connman network connection manager"))
155 (type 'network-management)
156 (snippet '((service connman-service-type)
157 (service wpa-supplicant-service-type))))
158 (system-service
159 (name (G_ "DHCP client (dynamic IP address assignment)"))
160 (type 'network-management)
161 (snippet '((service dhcpcd-service-type))))
162 (system-service
163 (name (G_ "Static networking service."))
164 (type 'network-management)
165 (snippet `((service
166 static-networking-service-type
167 (list %loopback-static-networking
168 (static-networking
169 (addresses
170 (list
171 (network-address
172 (device "eth0")
173 ,(comment (G_ ";; Fill-in your IP.\n"))
174 (value "192.168.178.10/24"))))
175 (routes
176 (list (network-route
177 (destination "default")
178 ,(comment (G_ ";; Fill-in your gateway IP.\n"))
179 (gateway "192.168.178.1"))))
180 (requirement '())
181 (provision '(networking))
182 ,(comment (G_ ";; Fill-in your nameservers.\n"))
183 (name-servers '("192.168.178.1"))))))))
184
185 ;; Dealing with documents.
186 (system-service
187 (name (G_ "CUPS printing system (no Web interface by default)"))
188 (type 'document)
189 (snippet '((service cups-service-type)))))))
190
191(define (desktop-system-service? service)
192 "Return true if SERVICE is a desktop environment service."
193 (eq? 'desktop (system-service-type service)))
194
195(define (system-services->configuration services)
196 "Return the configuration field for SERVICES."
197 (let* ((snippets (append-map system-service-snippet services))
198 (desktop? (find desktop-system-service? services))
199 (packages
200 (append (append-map system-service-packages services)
201 (if desktop?
202 (cons (comment (G_ ";; Fonts to cover all languages.\n"))
203 (map (lambda (package)
204 `(specification->package ,package))
205 '("font-google-noto"
206 "font-google-noto-emoji"
207 ;; FIXME: Selection of fonts depends on the
208 ;; locale. Use a monospaced CJK font with
209 ;; latin letters before there's proper fix.
210 ;; See <https://codeberg.org/guix/guix/pulls/5654#issuecomment-9928509>
211 "font-sarasa-gothic")))
212 '())))
213 (base (if desktop?
214 (if (target-hurd?)
215 '%desktop-services/hurd
216 '%desktop-services)
217 (if (target-hurd?)
218 '%base-services/hurd
219 '%base-services)))
220 (native-console-font (match (false-if-exception
221 (string-take (getenv "LANGUAGE") 2))
222 ((or "el" ;easier with more complete Greek font
223 ;; These need Cyrillic:
224 "be" "bg" "kk" "ky"
225 "mk" "mn" "ru" "sr" "tg" "uk")
226 "LatGrkCyr-8x16")
227 (_ #f)))
228 (services (if native-console-font
229 `(modify-services ,base
230 (console-font-service-type
231 config => (map (lambda (tty)
232 (cons (car tty)
233 ,native-console-font))
234 config)))
235 base))
236 (service-heading (list (vertical-space 1)
237 (comment (G_ "\
238;; Below is the list of system services. To search for available
239;; services, run 'guix system search KEYWORD' in a terminal.\n"))))
240 (package-heading (list (vertical-space 1)
241 (comment (G_ "\
242;; Packages installed system-wide. Users can also install packages
243;; under their own account: use 'guix search KEYWORD' to search
244;; for packages and 'guix install PACKAGE' to install a package.\n")))))
245
246 `(,@(if (null? packages)
247 (if (target-hurd?)
248 `(,@package-heading
249 (packages %base-packages/hurd))
250 '())
251 `(,@package-heading
252 (packages (append (list ,@packages)
253 ,(if (target-hurd?)
254 '%base-packages/hurd
255 '%base-packages)))))
256
257 ,@service-heading
258 ,(if (and (null? snippets)
259 (not desktop?))
260 `(services ,services)
261 `(services
262 (append (list ,@snippets
263
264 ,@(if desktop?
265 ;; XXX: Assume 'keyboard-layout' is in scope.
266 `((set-xorg-configuration
267 (xorg-configuration
268 (keyboard-layout keyboard-layout))))
269 '()))
270
271 ,(vertical-space 1)
272 ,(comment (G_ "\
273;; This is the default list of services we
274;; are appending to.\n"))
275 ,services))))))