projects/guix·blob ruby-team · refs

165 lines · 6.3 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2021 Andrew Tropin <[email protected]>
3;;; Copyright © 2022, 2024-2025 Ludovic Courtès <[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 home)
21 #:use-module (gnu home services)
22 #:use-module (gnu home services symlink-manager)
23 #:use-module (gnu home services shells)
24 #:use-module (gnu home services shepherd)
25 #:use-module (gnu home services xdg)
26 #:use-module (gnu home services fontutils)
27 #:use-module (gnu home services admin)
28 #:use-module (gnu services)
29 #:use-module (guix records)
30 #:use-module (guix diagnostics)
31 #:use-module (guix gexp)
32 #:use-module (guix store)
33 #:use-module (ice-9 match)
34 #:use-module (ice-9 regex)
35 #:export (home-environment
36 home-environment?
37 this-home-environment
38
39 home-environment-derivation
40 home-environment-packages
41 home-environment-user-services
42 home-environment-essential-services
43 home-environment-default-essential-services
44 home-environment-services
45 home-environment-location
46
47 home-environment-with-provenance
48
49 home-generation-base
50
51 %base-home-services))
52
53;;; Comment:
54;;;
55;;; This module provides a <home-environment> record for managing
56;;; per-user packages and configuration files in the similar way as
57;;; <operating-system> do for system packages and configuration files.
58;;;
59;;; Code:
60
61(define-record-type* <home-environment> home-environment
62 make-home-environment
63 home-environment?
64 this-home-environment
65
66 (packages home-environment-packages ; list of (PACKAGE OUTPUT...)
67 (default '()))
68
69 (essential-services home-environment-essential-services ; list of services
70 (thunked)
71 (default (home-environment-default-essential-services
72 this-home-environment)))
73
74 (services home-environment-user-services
75 (default %base-home-services)
76 (sanitize validate-service-list))
77
78 (location home-environment-location ; <location>
79 (default (and=> (current-source-location)
80 source-properties->location))
81 (innate)))
82
83(define %base-home-services
84 ;; Non-essential but useful services to have by default.
85 (list (service home-log-rotation-service-type)
86 (service home-shepherd-timer-service-type)
87 (service home-shepherd-transient-service-type)))
88
89(define (home-environment-default-essential-services he)
90 "Return the list of essential services for home environment."
91 (list
92 (service home-run-on-first-login-service-type)
93 (service home-activation-service-type)
94 (service home-environment-variables-service-type)
95
96 (service home-symlink-manager-service-type)
97
98 (service home-fontconfig-service-type)
99 (service home-xdg-base-directories-service-type)
100 (service home-shell-profile-service-type)
101
102 (service home-service-type)
103 (service home-profile-service-type (home-environment-packages he))))
104
105(define* (home-environment-services he)
106 "Return all the services of home environment."
107 (instantiate-missing-services
108 (append (home-environment-user-services he)
109 (home-environment-essential-services he))))
110
111(define* (home-environment-derivation he)
112 "Return a derivation that builds home environment."
113 (let* ((services (home-environment-services he))
114 (home (fold-services services
115 #:target-type home-service-type)))
116 (service-value home)))
117
118
119(define (home-environment-configuration-file he)
120 "Return the configuration file of HE, based on its 'location' field, or #f
121if it could not be determined."
122 (let ((file (and=> (home-environment-location he)
123 location-file)))
124 (and file
125 (or (and (string-prefix? "/" file) file)
126 (search-path %load-path file)))))
127
128(define* (home-environment-with-provenance he
129 #:optional
130 (config-file
131 (home-environment-configuration-file
132 he)))
133 "Return a variant of HE that stores its own provenance information,
134including CONFIG-FILE, if available. This is achieved by adding an instance
135of HOME-PROVENANCE-SERVICE-TYPE to its services."
136 (home-environment
137 (inherit he)
138 (services (cons (service home-provenance-service-type config-file)
139 (home-environment-user-services he)))))
140
141(define-gexp-compiler (home-environment-compiler (he <home-environment>)
142 system target)
143 ((store-lift
144 (lambda (store)
145 (run-with-store store (home-environment-derivation he)
146 #:system system
147 #:target target)))))
148
149(define %profile-generation-rx
150 ;; Regexp that matches profile generation.
151 (make-regexp "(.*)-([0-9]+)-link$"))
152
153(define (home-generation-base file)
154 "If FILE is a Home generation GC root such as \"guix-home-42-link\",
155return its corresponding base---e.g., \"guix-home\". Otherwise return #f.
156
157This is similar to the 'generation-profile' procedure but applied to Home
158generations."
159 (match (regexp-exec %profile-generation-rx file)
160 (#f #f)
161 (m (let ((profile (match:substring m 1)))
162 ;; Distinguish from a "real" profile and from a system generation.
163 (and (file-exists? (string-append profile "/on-first-login"))
164 (file-exists? (string-append profile "/profile/manifest"))
165 profile)))))