home: Add provenance home type. * home/provenance.scm: New file. * home.scm (<home>): Export 'home-configurations'. * doc/provenance.md: New file. * doc/README.md: Add it. Signed-off-by: Julien Lepiller <julien@lepiller.eu>
doc/README.md
66 | 66 | * [Neovim](doc/neovim.md) | |
67 | 67 | * [Zsh](doc/zsh.md) | |
68 | 68 | ||
69 | + | ### Reproducible builds | |
70 | + | ||
71 | + | * [Provenance](doc/provenance.md) | |
72 | + | ||
69 | 73 | ### Common Issues | |
70 | 74 | ||
71 | 75 | #### No Sound on the System |
doc/provenance.md unknown status 1
1 | + | Provenance | |
2 | + | ====== | |
3 | + | ||
4 | + | This lets you record provenance meta-data in generated homes. It adds | |
5 | + | a `.provenance` file, as well `.channels.scm` and `.home.scm` files | |
6 | + | when applicable. | |
7 | + | ||
8 | + | These files allow you to recreate your home at a later point in time: | |
9 | + | ||
10 | + | ```bash | |
11 | + | guix time-machine --channels=.channels.scm -- home build .home.scm | |
12 | + | ``` | |
13 | + | ||
14 | + | Main Configuration | |
15 | + | ------------------ | |
16 | + | ||
17 | + | Provenance meta-data is automatically generated by using the | |
18 | + | `provenance-home-type` service type. | |
19 | + | ||
20 | + | **Scheme Procedure**: provenance-home-type | |
21 | + | ||
22 | + | The type of service that generates provenance files for your generated | |
23 | + | home. Its value is a location object. | |
24 | + | ||
25 | + | **Scheme Procedure**: (home-with-provenance h [configuration-file]) | |
26 | + | ||
27 | + | Return a variant of _h_ that stores its own provenance information, | |
28 | + | including _configuration-file_, if available. When | |
29 | + | _configuration-file_ is omitted, the location where _h_ is defined is | |
30 | + | used. | |
31 | + | ||
32 | + | Example Configuration | |
33 | + | --------------------- | |
34 | + | ||
35 | + | ```scheme | |
36 | + | (home-with-provenance | |
37 | + | (home | |
38 | + | (data-directory "/data/alice") | |
39 | + | (configurations | |
40 | + | (list | |
41 | + | (user-home something-home-type ...) | |
42 | + | ...)))) | |
43 | + | ``` | |
44 | + | ||
45 | + |
home.scm
35 | 35 | home | |
36 | 36 | home? | |
37 | 37 | home-data-directory | |
38 | + | home-configurations | |
38 | 39 | home-location | |
39 | 40 | home-guix-symlink | |
40 | 41 | home-guix-config-symlink |
home/provenance.scm unknown status 1
1 | + | ;;; Guix Home Manager. | |
2 | + | ;;; | |
3 | + | ;;; Copyright ?? 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Court??s <ludo@gnu.org> | |
4 | + | ;;; Copyright ?? 2016 Chris Marusich <cmmarusich@gmail.com> | |
5 | + | ;;; Copyright ?? 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> | |
6 | + | ;;; Copyright ?? 2020 Jelle Licht <jlicht@fsfe.org> | |
7 | + | ;;; | |
8 | + | ;;; This file is based on work found in GNU Guix. | |
9 | + | ;;; | |
10 | + | ;;; This program is free software: you can redistribute it and/or modify | |
11 | + | ;;; it under the terms of the GNU General Public License as published by | |
12 | + | ;;; the Free Software Foundation, either version 3 of the License, or | |
13 | + | ;;; (at your option) any later version. | |
14 | + | ;;; | |
15 | + | ;;; This program is distributed in the hope that it will be useful, | |
16 | + | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | + | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | + | ;;; GNU General Public License for more details. | |
19 | + | ;;; | |
20 | + | ;;; You should have received a copy of the GNU General Public License | |
21 | + | ;;; along with this program. If not, see <http://www.gnu.org/licenses/>. | |
22 | + | ||
23 | + | (define-module (home provenance) | |
24 | + | #:use-module (gnu services) | |
25 | + | #:use-module (guix channels) | |
26 | + | #:use-module (guix describe) | |
27 | + | #:use-module (guix diagnostics) | |
28 | + | #:autoload (guix openpgp) (openpgp-format-fingerprint) | |
29 | + | #:use-module (guix gexp) | |
30 | + | #:use-module (guix monads) | |
31 | + | #:use-module (guix profiles) | |
32 | + | #:use-module (guix records) | |
33 | + | #:use-module (guix store) | |
34 | + | #:use-module (home) | |
35 | + | #:autoload (ice-9 pretty-print) (pretty-print) | |
36 | + | #:export (provenance-home-type | |
37 | + | home-with-provenance)) | |
38 | + | ||
39 | + | (define (object->pretty-string obj) | |
40 | + | "Like 'object->string', but using 'pretty-print'." | |
41 | + | (call-with-output-string | |
42 | + | (lambda (port) | |
43 | + | (pretty-print obj port)))) | |
44 | + | ||
45 | + | (define (channel->code channel) | |
46 | + | "Return code to build CHANNEL, ready to be dropped in a 'channels.scm' | |
47 | + | file." | |
48 | + | ;; Since the 'introduction' field is backward-incompatible, and since it's | |
49 | + | ;; optional when using the "official" 'guix channel, include it if and only | |
50 | + | ;; if we're referring to a different channel. | |
51 | + | (let ((intro (and (not (equal? (list channel) %default-channels)) | |
52 | + | (channel-introduction channel)))) | |
53 | + | `(channel (name ',(channel-name channel)) | |
54 | + | (url ,(channel-url channel)) | |
55 | + | (branch ,(channel-branch channel)) | |
56 | + | (commit ,(channel-commit channel)) | |
57 | + | ,@(if intro | |
58 | + | `((introduction | |
59 | + | (make-channel-introduction | |
60 | + | ,(channel-introduction-first-signed-commit intro) | |
61 | + | (openpgp-fingerprint | |
62 | + | ,(openpgp-format-fingerprint | |
63 | + | (channel-introduction-first-commit-signer | |
64 | + | intro)))))) | |
65 | + | '())))) | |
66 | + | ||
67 | + | (define (channel->sexp channel) | |
68 | + | "Return an sexp describing CHANNEL. The sexp is _not_ code and is meant to | |
69 | + | be parsed by tools; it's potentially more future-proof than code." | |
70 | + | ;; TODO: Add CHANNEL's introduction. Currently we can't do that because | |
71 | + | ;; older 'guix system describe' expect exactly name/url/branch/commit | |
72 | + | ;; without any additional fields. | |
73 | + | `(channel (name ,(channel-name channel)) | |
74 | + | (url ,(channel-url channel)) | |
75 | + | (branch ,(channel-branch channel)) | |
76 | + | (commit ,(channel-commit channel)))) | |
77 | + | ||
78 | + | (define (provenance-file channels configuration-file) | |
79 | + | "Return a 'provenance' file describing CHANNELS, a list of channels, and | |
80 | + | CONFIGURATION-FILE, which can be either #f or a <local-file> containing the OS | |
81 | + | configuration being used." | |
82 | + | (scheme-file "provenance" | |
83 | + | #~(provenance | |
84 | + | (version 0) | |
85 | + | (channels #+@(if channels | |
86 | + | (map channel->sexp channels) | |
87 | + | '())) | |
88 | + | (configuration-file #+configuration-file)))) | |
89 | + | ||
90 | + | (define (provenance-entry config-file) | |
91 | + | "Return system entries describing the operating system provenance: the | |
92 | + | channels in use and CONFIG-FILE, if it is true." | |
93 | + | (define profile | |
94 | + | (current-profile)) | |
95 | + | ||
96 | + | (define channels | |
97 | + | (and=> profile profile-channels)) | |
98 | + | ||
99 | + | (let ((config-file (cond ((string? config-file) | |
100 | + | (local-file config-file "home.scm")) | |
101 | + | ((not config-file) | |
102 | + | #f) | |
103 | + | (else | |
104 | + | config-file)))) | |
105 | + | `((".provenance" ,(provenance-file channels config-file)) | |
106 | + | ,@(if channels | |
107 | + | `((".channels.scm" | |
108 | + | ,(plain-file "channels.scm" | |
109 | + | (object->pretty-string | |
110 | + | `(list | |
111 | + | ,@(map channel->code channels)))))) | |
112 | + | '()) | |
113 | + | ,@(if config-file | |
114 | + | `((".home.scm" ,config-file)) | |
115 | + | '())))) | |
116 | + | ||
117 | + | (define provenance-home-type | |
118 | + | (home-type | |
119 | + | (name 'provenance) | |
120 | + | (extensions | |
121 | + | (list | |
122 | + | (home-extension | |
123 | + | (target root-home-type) | |
124 | + | (compute provenance-entry)))) | |
125 | + | (description "The provenance home type"))) | |
126 | + | ||
127 | + | (define (home-configuration-file h) | |
128 | + | "Return the configuration file of H, based on its 'location' field, or #f | |
129 | + | if it could not be determined." | |
130 | + | (let ((file (and=> (home-location h) | |
131 | + | location-file))) | |
132 | + | (and file | |
133 | + | (or (and (string-prefix? "/" file) file) | |
134 | + | (search-path %load-path file))))) | |
135 | + | ||
136 | + | (define* (home-with-provenance h | |
137 | + | #:optional | |
138 | + | (configuration-file | |
139 | + | (home-configuration-file h))) | |
140 | + | "Return a variant of H that stores its own provenance information, | |
141 | + | including CONFIGURATION-FILE, if available. This is achieved by adding an | |
142 | + | instance of PROVENANCE-HOME-TYPE to its configurations." | |
143 | + | (home | |
144 | + | (inherit h) | |
145 | + | (configurations (cons (user-home provenance-home-type configuration-file) | |
146 | + | (home-configurations h))))) |