Commit | Line | Data |
---|---|---|
0d39a3b9 | 1 | ;;; GNU Guix --- Functional package management for GNU |
f75243e1 | 2 | ;;; Copyright © 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> |
af12790b | 3 | ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> |
53f21642 | 4 | ;;; Copyright © 2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> |
0d39a3b9 LC |
5 | ;;; |
6 | ;;; This file is part of GNU Guix. | |
7 | ;;; | |
8 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
9 | ;;; under the terms of the GNU General Public License as published by | |
10 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
11 | ;;; your option) any later version. | |
12 | ;;; | |
13 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
14 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
16 | ;;; GNU General Public License for more details. | |
17 | ;;; | |
18 | ;;; You should have received a copy of the GNU General Public License | |
19 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
20 | ||
21 | (define-module (guix channels) | |
8ba7fd3c | 22 | #:use-module (git) |
0d39a3b9 | 23 | #:use-module (guix git) |
43badf26 LC |
24 | #:use-module (guix git-authenticate) |
25 | #:use-module ((guix openpgp) | |
26 | #:select (openpgp-public-key-fingerprint | |
27 | openpgp-format-fingerprint)) | |
28 | #:use-module (guix base16) | |
0d39a3b9 LC |
29 | #:use-module (guix records) |
30 | #:use-module (guix gexp) | |
5fbdc9a5 | 31 | #:use-module (guix modules) |
0d39a3b9 LC |
32 | #:use-module (guix discovery) |
33 | #:use-module (guix monads) | |
34 | #:use-module (guix profiles) | |
37c0d458 | 35 | #:use-module (guix packages) |
43badf26 | 36 | #:use-module (guix progress) |
0d39a3b9 | 37 | #:use-module (guix derivations) |
f58f676b | 38 | #:use-module (guix combinators) |
69962ab7 | 39 | #:use-module (guix diagnostics) |
8ba7fd3c | 40 | #:use-module (guix sets) |
0d39a3b9 LC |
41 | #:use-module (guix store) |
42 | #:use-module (guix i18n) | |
ab6025b5 LC |
43 | #:use-module ((guix utils) |
44 | #:select (source-properties->location | |
f75243e1 LC |
45 | &error-location |
46 | &fix-hint)) | |
0d39a3b9 | 47 | #:use-module (srfi srfi-1) |
af12790b | 48 | #:use-module (srfi srfi-2) |
0d39a3b9 LC |
49 | #:use-module (srfi srfi-9) |
50 | #:use-module (srfi srfi-11) | |
9719e8d3 | 51 | #:use-module (srfi srfi-26) |
ab6025b5 LC |
52 | #:use-module (srfi srfi-34) |
53 | #:use-module (srfi srfi-35) | |
5fbdc9a5 LC |
54 | #:autoload (guix self) (whole-package make-config.scm) |
55 | #:autoload (guix inferior) (gexp->derivation-in-inferior) ;FIXME: circular dep | |
20507347 | 56 | #:autoload (guix quirks) (%quirks %patches applicable-patch? apply-patch) |
43badf26 | 57 | #:use-module (ice-9 format) |
0d39a3b9 | 58 | #:use-module (ice-9 match) |
ed75bdf3 | 59 | #:use-module (ice-9 vlist) |
37c0d458 | 60 | #:use-module ((ice-9 rdelim) #:select (read-string)) |
43badf26 | 61 | #:use-module ((rnrs bytevectors) #:select (bytevector=?)) |
0d39a3b9 LC |
62 | #:export (channel |
63 | channel? | |
64 | channel-name | |
65 | channel-url | |
66 | channel-branch | |
67 | channel-commit | |
43badf26 | 68 | channel-introduction |
0d39a3b9 LC |
69 | channel-location |
70 | ||
43badf26 LC |
71 | channel-introduction? |
72 | ;; <channel-introduction> accessors purposefully omitted for now. | |
73 | ||
0d39a3b9 | 74 | %default-channels |
72f749dc | 75 | guix-channel? |
0d39a3b9 LC |
76 | |
77 | channel-instance? | |
78 | channel-instance-channel | |
79 | channel-instance-commit | |
80 | channel-instance-checkout | |
81 | ||
43badf26 | 82 | authenticate-channel |
0d39a3b9 | 83 | latest-channel-instances |
fe5db4eb | 84 | checkout->channel-instance |
030f1367 | 85 | latest-channel-derivation |
c37f38bd | 86 | channel-instances->manifest |
5fbdc9a5 | 87 | %channel-profile-hooks |
a7c714d3 | 88 | channel-instances->derivation |
872898f7 | 89 | ensure-forward-channel-update |
a7c714d3 | 90 | |
8ba7fd3c LC |
91 | profile-channels |
92 | ||
93 | channel-news-entry? | |
94 | channel-news-entry-commit | |
9719e8d3 | 95 | channel-news-entry-tag |
8ba7fd3c LC |
96 | channel-news-entry-title |
97 | channel-news-entry-body | |
98 | ||
99 | channel-news-for-commit)) | |
0d39a3b9 LC |
100 | |
101 | ;;; Commentary: | |
102 | ;;; | |
103 | ;;; This module implements "channels." A channel is usually a source of | |
104 | ;;; package definitions. There's a special channel, the 'guix' channel, that | |
105 | ;;; provides all of Guix, including its commands and its documentation. | |
106 | ;;; User-defined channels are expected to typically provide a bunch of .scm | |
107 | ;;; files meant to be added to the '%package-search-path'. | |
108 | ;;; | |
109 | ;;; This module provides tools to fetch and update channels from a Git | |
110 | ;;; repository and to build them. | |
111 | ;;; | |
112 | ;;; Code: | |
113 | ||
114 | (define-record-type* <channel> channel make-channel | |
115 | channel? | |
116 | (name channel-name) | |
117 | (url channel-url) | |
118 | (branch channel-branch (default "master")) | |
119 | (commit channel-commit (default #f)) | |
43badf26 | 120 | (introduction channel-introduction (default #f)) |
0d39a3b9 LC |
121 | (location channel-location |
122 | (default (current-source-location)) (innate))) | |
0d39a3b9 | 123 | |
43badf26 LC |
124 | ;; Channel introductions. A "channel introduction" provides a commit/signer |
125 | ;; pair that specifies the first commit of the authentication process as well | |
126 | ;; as its signer's fingerprint. The pair must be signed by the signer of that | |
127 | ;; commit so that only them may emit this introduction. Introductions are | |
128 | ;; used to bootstrap trust in a channel. | |
129 | (define-record-type <channel-introduction> | |
130 | (make-channel-introduction first-signed-commit first-commit-signer | |
131 | signature) | |
132 | channel-introduction? | |
133 | (first-signed-commit channel-introduction-first-signed-commit) ;hex string | |
134 | (first-commit-signer channel-introduction-first-commit-signer) ;bytevector | |
135 | (signature channel-introduction-signature)) ;string | |
136 | ||
137 | (define %guix-channel-introduction | |
138 | ;; Introduction of the official 'guix channel. The chosen commit is the | |
139 | ;; first one that introduces '.guix-authorizations' on the 'staging' | |
140 | ;; branch that was eventually merged in 'master'. Any branch starting | |
141 | ;; before that commit cannot be merged or it will be rejected by 'guix pull' | |
142 | ;; & co. | |
143 | (make-channel-introduction | |
144 | "9edb3f66fd807b096b48283debdcddccfea34bad" ;2020-05-26 | |
145 | (base16-string->bytevector | |
146 | (string-downcase | |
147 | (string-filter char-set:hex-digit ;mbakke | |
148 | "BBB0 2DDF 2CEA F6A8 0D1D E643 A2A0 6DF2 A33A 54FA"))) | |
149 | #f)) ;TODO: Add an intro signature so it can be exported. | |
150 | ||
0d39a3b9 LC |
151 | (define %default-channels |
152 | ;; Default list of channels. | |
153 | (list (channel | |
154 | (name 'guix) | |
37a6cdbf | 155 | (branch "master") |
43badf26 LC |
156 | (url "https://git.savannah.gnu.org/git/guix.git") |
157 | (introduction %guix-channel-introduction)))) | |
0d39a3b9 LC |
158 | |
159 | (define (guix-channel? channel) | |
160 | "Return true if CHANNEL is the 'guix' channel." | |
161 | (eq? 'guix (channel-name channel))) | |
162 | ||
163 | (define-record-type <channel-instance> | |
164 | (channel-instance channel commit checkout) | |
165 | channel-instance? | |
166 | (channel channel-instance-channel) | |
167 | (commit channel-instance-commit) | |
168 | (checkout channel-instance-checkout)) | |
169 | ||
af12790b | 170 | (define-record-type <channel-metadata> |
43badf26 | 171 | (channel-metadata directory dependencies news-file keyring-reference) |
af12790b | 172 | channel-metadata? |
ce5d9ec8 | 173 | (directory channel-metadata-directory) ;string with leading slash |
8ba7fd3c | 174 | (dependencies channel-metadata-dependencies) ;list of <channel> |
43badf26 LC |
175 | (news-file channel-metadata-news-file) ;string | #f |
176 | (keyring-reference channel-metadata-keyring-reference)) ;string | |
177 | ||
178 | (define %default-keyring-reference | |
179 | ;; Default value of the 'keyring-reference' field. | |
180 | "keyring") | |
af12790b | 181 | |
0d39a3b9 LC |
182 | (define (channel-reference channel) |
183 | "Return the \"reference\" for CHANNEL, an sexp suitable for | |
184 | 'latest-repository-commit'." | |
185 | (match (channel-commit channel) | |
186 | (#f `(branch . ,(channel-branch channel))) | |
187 | (commit `(commit . ,(channel-commit channel))))) | |
188 | ||
45b90332 LC |
189 | (define (read-channel-metadata port) |
190 | "Read from PORT channel metadata in the format expected for the | |
191 | '.guix-channel' file. Return a <channel-metadata> record, or raise an error | |
192 | if valid metadata could not be read from PORT." | |
193 | (match (read port) | |
194 | (('channel ('version 0) properties ...) | |
195 | (let ((directory (and=> (assoc-ref properties 'directory) first)) | |
8ba7fd3c | 196 | (dependencies (or (assoc-ref properties 'dependencies) '())) |
43badf26 LC |
197 | (news-file (and=> (assoc-ref properties 'news-file) first)) |
198 | (keyring-reference | |
199 | (or (and=> (assoc-ref properties 'keyring-reference) first) | |
200 | %default-keyring-reference))) | |
45b90332 | 201 | (channel-metadata |
8ba7fd3c | 202 | (cond ((not directory) "/") ;directory |
ce5d9ec8 LC |
203 | ((string-prefix? "/" directory) directory) |
204 | (else (string-append "/" directory))) | |
8ba7fd3c | 205 | (map (lambda (item) ;dependencies |
45b90332 LC |
206 | (let ((get (lambda* (key #:optional default) |
207 | (or (and=> (assoc-ref item key) first) default)))) | |
208 | (and-let* ((name (get 'name)) | |
209 | (url (get 'url)) | |
210 | (branch (get 'branch "master"))) | |
211 | (channel | |
212 | (name name) | |
213 | (branch branch) | |
214 | (url url) | |
215 | (commit (get 'commit)))))) | |
8ba7fd3c | 216 | dependencies) |
43badf26 LC |
217 | news-file |
218 | keyring-reference))) | |
45b90332 LC |
219 | ((and ('channel ('version version) _ ...) sexp) |
220 | (raise (condition | |
221 | (&message (message "unsupported '.guix-channel' version")) | |
222 | (&error-location | |
223 | (location (source-properties->location | |
224 | (source-properties sexp))))))) | |
225 | (sexp | |
226 | (raise (condition | |
227 | (&message (message "invalid '.guix-channel' file")) | |
228 | (&error-location | |
229 | (location (source-properties->location | |
230 | (source-properties sexp))))))))) | |
231 | ||
53f21642 JN |
232 | (define (read-channel-metadata-from-source source) |
233 | "Return a channel-metadata record read from channel's SOURCE/.guix-channel | |
ce5d9ec8 LC |
234 | description file, or return the default channel-metadata record if that file |
235 | doesn't exist." | |
45b90332 LC |
236 | (catch 'system-error |
237 | (lambda () | |
238 | (call-with-input-file (string-append source "/.guix-channel") | |
239 | read-channel-metadata)) | |
240 | (lambda args | |
241 | (if (= ENOENT (system-error-errno args)) | |
43badf26 | 242 | (channel-metadata "/" '() #f %default-keyring-reference) |
45b90332 LC |
243 | (apply throw args))))) |
244 | ||
245 | (define (channel-instance-metadata instance) | |
53f21642 | 246 | "Return a channel-metadata record read from the channel INSTANCE's |
ce5d9ec8 | 247 | description file or its default value." |
53f21642 JN |
248 | (read-channel-metadata-from-source (channel-instance-checkout instance))) |
249 | ||
af12790b RW |
250 | (define (channel-instance-dependencies instance) |
251 | "Return the list of channels that are declared as dependencies for the given | |
252 | channel INSTANCE." | |
ce5d9ec8 | 253 | (channel-metadata-dependencies (channel-instance-metadata instance))) |
af12790b | 254 | |
053b10c3 LC |
255 | (define (apply-patches checkout commit patches) |
256 | "Apply the matching PATCHES to CHECKOUT, modifying files in place. The | |
257 | result is unspecified." | |
258 | (let loop ((patches patches)) | |
259 | (match patches | |
260 | (() #t) | |
20507347 LC |
261 | ((patch rest ...) |
262 | (when (applicable-patch? patch checkout commit) | |
263 | (apply-patch patch checkout)) | |
053b10c3 LC |
264 | (loop rest))))) |
265 | ||
43badf26 LC |
266 | (define commit-short-id |
267 | (compose (cut string-take <> 7) oid->string commit-id)) | |
268 | ||
269 | (define (verify-introductory-commit repository introduction keyring) | |
270 | "Raise an exception if the first commit described in INTRODUCTION doesn't | |
271 | have the expected signer." | |
272 | (define commit-id | |
273 | (channel-introduction-first-signed-commit introduction)) | |
274 | ||
275 | (define actual-signer | |
276 | (openpgp-public-key-fingerprint | |
277 | (commit-signing-key repository (string->oid commit-id) | |
278 | keyring))) | |
279 | ||
280 | (define expected-signer | |
281 | (channel-introduction-first-commit-signer introduction)) | |
282 | ||
283 | (unless (bytevector=? expected-signer actual-signer) | |
284 | (raise (condition | |
285 | (&message | |
286 | (message (format #f (G_ "initial commit ~a is signed by '~a' \ | |
287 | instead of '~a'") | |
288 | commit-id | |
289 | (openpgp-format-fingerprint actual-signer) | |
290 | (openpgp-format-fingerprint expected-signer)))))))) | |
291 | ||
292 | (define* (authenticate-channel channel checkout commit | |
293 | #:key (keyring-reference-prefix "origin/")) | |
294 | "Authenticate the given COMMIT of CHANNEL, available at CHECKOUT, a | |
295 | directory containing a CHANNEL checkout. Raise an error if authentication | |
296 | fails." | |
297 | ;; XXX: Too bad we need to re-open CHECKOUT. | |
298 | (with-repository checkout repository | |
299 | (define start-commit | |
300 | (commit-lookup repository | |
301 | (string->oid | |
302 | (channel-introduction-first-signed-commit | |
303 | (channel-introduction channel))))) | |
304 | ||
305 | (define end-commit | |
306 | (commit-lookup repository (string->oid commit))) | |
307 | ||
308 | (define cache-key | |
309 | (string-append "channels/" (symbol->string (channel-name channel)))) | |
310 | ||
311 | (define keyring-reference | |
312 | (channel-metadata-keyring-reference | |
313 | (read-channel-metadata-from-source checkout))) | |
314 | ||
315 | (define keyring | |
316 | (load-keyring-from-reference repository | |
317 | (string-append keyring-reference-prefix | |
318 | keyring-reference))) | |
319 | ||
320 | (define authenticated-commits | |
321 | ;; Previously-authenticated commits that don't need to be checked again. | |
322 | (filter-map (lambda (id) | |
323 | (false-if-exception | |
324 | (commit-lookup repository (string->oid id)))) | |
325 | (previously-authenticated-commits cache-key))) | |
326 | ||
327 | (define commits | |
328 | ;; Commits to authenticate, excluding the closure of | |
329 | ;; AUTHENTICATED-COMMITS. | |
330 | (commit-difference end-commit start-commit | |
331 | authenticated-commits)) | |
332 | ||
333 | (define reporter | |
334 | (progress-reporter/bar (length commits))) | |
335 | ||
336 | ;; When COMMITS is empty, it's either because AUTHENTICATED-COMMITS | |
337 | ;; contains END-COMMIT or because END-COMMIT is not a descendant of | |
338 | ;; START-COMMIT. Check that. | |
339 | (if (null? commits) | |
340 | (match (commit-relation start-commit end-commit) | |
341 | ((or 'self 'ancestor 'descendant) #t) ;nothing to do! | |
342 | ('unrelated | |
343 | (raise | |
344 | (condition | |
345 | (&message | |
346 | (message | |
347 | (format #f (G_ "'~a' is not related to introductory \ | |
348 | commit of channel '~a'~%") | |
349 | (oid->string (commit-id end-commit)) | |
350 | (channel-name channel)))))))) | |
351 | (begin | |
352 | (format (current-error-port) | |
353 | (G_ "Authenticating channel '~a', \ | |
354 | commits ~a to ~a (~h new commits)...~%") | |
355 | (channel-name channel) | |
356 | (commit-short-id start-commit) | |
357 | (commit-short-id end-commit) | |
358 | (length commits)) | |
359 | ||
360 | ;; If it's our first time, verify CHANNEL's introductory commit. | |
361 | (when (null? authenticated-commits) | |
362 | (verify-introductory-commit repository | |
363 | (channel-introduction channel) | |
364 | keyring)) | |
365 | ||
366 | (call-with-progress-reporter reporter | |
367 | (lambda (report) | |
368 | (authenticate-commits repository commits | |
369 | #:keyring keyring | |
370 | #:report-progress report))) | |
371 | ||
372 | (cache-authenticated-commit cache-key | |
373 | (oid->string | |
374 | (commit-id end-commit))))))) | |
375 | ||
053b10c3 | 376 | (define* (latest-channel-instance store channel |
872898f7 LC |
377 | #:key (patches %patches) |
378 | starting-commit) | |
379 | "Return two values: the latest channel instance for CHANNEL, and its | |
380 | relation to STARTING-COMMIT when provided." | |
053b10c3 LC |
381 | (define (dot-git? file stat) |
382 | (and (string=? (basename file) ".git") | |
383 | (eq? 'directory (stat:type stat)))) | |
384 | ||
8d1d5657 | 385 | (let-values (((checkout commit relation) |
053b10c3 | 386 | (update-cached-checkout (channel-url channel) |
872898f7 LC |
387 | #:ref (channel-reference channel) |
388 | #:starting-commit starting-commit))) | |
43badf26 LC |
389 | (if (channel-introduction channel) |
390 | (authenticate-channel channel checkout commit) | |
391 | ;; TODO: Warn for all the channels once the authentication interface | |
392 | ;; is public. | |
393 | (when (guix-channel? channel) | |
394 | (warning (G_ "channel '~a' lacks an introduction and \ | |
395 | cannot be authenticated~%") | |
396 | (channel-name channel)))) | |
397 | ||
053b10c3 LC |
398 | (when (guix-channel? channel) |
399 | ;; Apply the relevant subset of PATCHES directly in CHECKOUT. This is | |
400 | ;; safe to do because 'switch-to-ref' eventually does a hard reset. | |
401 | (apply-patches checkout commit patches)) | |
402 | ||
403 | (let* ((name (url+commit->name (channel-url channel) commit)) | |
404 | (checkout (add-to-store store name #t "sha256" checkout | |
405 | #:select? (negate dot-git?)))) | |
872898f7 LC |
406 | (values (channel-instance channel commit checkout) |
407 | relation)))) | |
408 | ||
409 | (define (ensure-forward-channel-update channel start instance relation) | |
410 | "Raise an error if RELATION is not 'ancestor, meaning that START is not an | |
411 | ancestor of the commit in INSTANCE, unless CHANNEL specifies a commit. | |
412 | ||
413 | This procedure implements a channel update policy meant to be used as a | |
414 | #:validate-pull argument." | |
415 | (match relation | |
416 | ('ancestor #t) | |
417 | ('self #t) | |
418 | (_ | |
9744cc7b LC |
419 | (raise (make-compound-condition |
420 | (condition | |
421 | (&message (message | |
422 | (format #f (G_ "\ | |
872898f7 | 423 | aborting update of channel '~a' to commit ~a, which is not a descendant of ~a") |
9744cc7b LC |
424 | (channel-name channel) |
425 | (channel-instance-commit instance) | |
426 | start)))) | |
872898f7 | 427 | |
9744cc7b LC |
428 | ;; If the user asked for a specific commit, they might want |
429 | ;; that to happen nevertheless, so tell them about the | |
430 | ;; relevant 'guix pull' option. | |
431 | (if (channel-commit channel) | |
432 | (condition | |
433 | (&fix-hint | |
434 | (hint (G_ "Use @option{--allow-downgrades} to force | |
435 | this downgrade.")))) | |
436 | (condition | |
437 | (&fix-hint | |
438 | (hint (G_ "This could indicate that the channel has | |
872898f7 LC |
439 | been tampered with and is trying to force a roll-back, preventing you from |
440 | getting the latest updates. If you think this is not the case, explicitly | |
9744cc7b | 441 | allow non-forward updates.")))))))))) |
872898f7 LC |
442 | |
443 | (define* (latest-channel-instances store channels | |
444 | #:key | |
445 | (current-channels '()) | |
446 | (validate-pull | |
447 | ensure-forward-channel-update)) | |
0d39a3b9 | 448 | "Return a list of channel instances corresponding to the latest checkouts of |
872898f7 LC |
449 | CHANNELS and the channels on which they depend. |
450 | ||
451 | CURRENT-CHANNELS is the list of currently used channels. It is compared | |
452 | against the newly-fetched instances of CHANNELS, and VALIDATE-PULL is called | |
453 | for each channel update and can choose to emit warnings or raise an error, | |
454 | depending on the policy it implements." | |
af12790b RW |
455 | ;; Only process channels that are unique, or that are more specific than a |
456 | ;; previous channel specification. | |
457 | (define (ignore? channel others) | |
458 | (member channel others | |
459 | (lambda (a b) | |
460 | (and (eq? (channel-name a) (channel-name b)) | |
461 | (or (channel-commit b) | |
462 | (not (or (channel-commit a) | |
463 | (channel-commit b)))))))) | |
f58f676b | 464 | |
872898f7 LC |
465 | (define (current-commit name) |
466 | ;; Return the current commit for channel NAME. | |
467 | (any (lambda (channel) | |
468 | (and (eq? (channel-name channel) name) | |
469 | (channel-commit channel))) | |
470 | current-channels)) | |
471 | ||
9b049de8 LC |
472 | (let loop ((channels channels) |
473 | (previous-channels '())) | |
474 | ;; Accumulate a list of instances. A list of processed channels is also | |
475 | ;; accumulated to decide on duplicate channel specifications. | |
476 | (define-values (resulting-channels instances) | |
477 | (fold2 (lambda (channel previous-channels instances) | |
478 | (if (ignore? channel previous-channels) | |
479 | (values previous-channels instances) | |
480 | (begin | |
481 | (format (current-error-port) | |
482 | (G_ "Updating channel '~a' from Git repository at '~a'...~%") | |
483 | (channel-name channel) | |
484 | (channel-url channel)) | |
872898f7 LC |
485 | (let*-values (((current) |
486 | (current-commit (channel-name channel))) | |
487 | ((instance relation) | |
488 | (latest-channel-instance store channel | |
489 | #:starting-commit | |
490 | current))) | |
491 | (when relation | |
492 | (validate-pull channel current instance relation)) | |
493 | ||
9b049de8 LC |
494 | (let-values (((new-instances new-channels) |
495 | (loop (channel-instance-dependencies instance) | |
496 | previous-channels))) | |
497 | (values (append (cons channel new-channels) | |
498 | previous-channels) | |
499 | (append (cons instance new-instances) | |
500 | instances))))))) | |
501 | previous-channels | |
502 | '() ;instances | |
503 | channels)) | |
f58f676b | 504 | |
9b049de8 LC |
505 | (let ((instance-name (compose channel-name channel-instance-channel))) |
506 | ;; Remove all earlier channel specifications if they are followed by a | |
507 | ;; more specific one. | |
508 | (values (delete-duplicates instances | |
509 | (lambda (a b) | |
510 | (eq? (instance-name a) (instance-name b)))) | |
511 | resulting-channels)))) | |
0d39a3b9 | 512 | |
fe5db4eb LC |
513 | (define* (checkout->channel-instance checkout |
514 | #:key commit | |
515 | (url checkout) (name 'guix)) | |
516 | "Return a channel instance for CHECKOUT, which is assumed to be a checkout | |
517 | of COMMIT at URL. Use NAME as the channel name." | |
518 | (let* ((commit (or commit (make-string 40 #\0))) | |
519 | (channel (channel (name name) | |
520 | (commit commit) | |
521 | (url url)))) | |
522 | (channel-instance channel commit checkout))) | |
523 | ||
0d39a3b9 LC |
524 | (define %self-build-file |
525 | ;; The file containing code to build Guix. This serves the same purpose as | |
526 | ;; a makefile, and, similarly, is intended to always keep this name. | |
527 | "build-aux/build-self.scm") | |
528 | ||
529 | (define %pull-version | |
530 | ;; This is the version of the 'guix pull' protocol. It specifies what's | |
531 | ;; expected from %SELF-BUILD-FILE. The initial version ("0") was when we'd | |
532 | ;; place a set of compiled Guile modules in ~/.config/guix/latest. | |
533 | 1) | |
534 | ||
acefa740 LC |
535 | (define (standard-module-derivation name source core dependencies) |
536 | "Return a derivation that builds with CORE, a Guix instance, the Scheme | |
537 | modules in SOURCE and that depend on DEPENDENCIES, a list of lowerable | |
538 | objects. The assumption is that SOURCE contains package modules to be added | |
539 | to '%package-module-path'." | |
acefa740 | 540 | |
53f21642 | 541 | (let* ((metadata (read-channel-metadata-from-source source)) |
ce5d9ec8 | 542 | (directory (channel-metadata-directory metadata))) |
53f21642 JN |
543 | |
544 | (define build | |
545 | ;; This is code that we'll run in CORE, a Guix instance, with its own | |
546 | ;; modules and so on. That way, we make sure these modules are built for | |
547 | ;; the right Guile version, with the right dependencies, and that they get | |
548 | ;; to see the right (gnu packages …) modules. | |
549 | (with-extensions dependencies | |
550 | #~(begin | |
551 | (use-modules (guix build compile) | |
552 | (guix build utils) | |
553 | (srfi srfi-26)) | |
554 | ||
555 | (define go | |
556 | (string-append #$output "/lib/guile/" (effective-version) | |
557 | "/site-ccache")) | |
558 | (define scm | |
559 | (string-append #$output "/share/guile/site/" | |
560 | (effective-version))) | |
acefa740 | 561 | |
ce5d9ec8 | 562 | (let* ((subdir #$directory) |
53f21642 JN |
563 | (source (string-append #$source subdir))) |
564 | (compile-files source go (find-files source "\\.scm$")) | |
565 | (mkdir-p (dirname scm)) | |
566 | (symlink (string-append #$source subdir) scm)) | |
acefa740 | 567 | |
53f21642 | 568 | scm))) |
acefa740 | 569 | |
53f21642 | 570 | (gexp->derivation-in-inferior name build core))) |
0d39a3b9 | 571 | |
37c0d458 LC |
572 | (define* (guile-for-source source #:optional (quirks %quirks)) |
573 | "Return the Guile package to use when building SOURCE or #f if the default | |
574 | '%guile-for-build' should be good enough." | |
575 | (let loop ((quirks quirks)) | |
576 | (match quirks | |
577 | (() | |
578 | #f) | |
579 | (((predicate . guile) rest ...) | |
580 | (if (predicate source) (guile) (loop rest)))))) | |
581 | ||
9db88369 LC |
582 | (define (call-with-guile guile thunk) |
583 | (lambda (store) | |
584 | (values (parameterize ((%guile-for-build | |
585 | (if guile | |
586 | (package-derivation store guile) | |
587 | (%guile-for-build)))) | |
588 | (run-with-store store (thunk))) | |
589 | store))) | |
590 | ||
591 | (define-syntax-rule (with-guile guile exp ...) | |
592 | "Set GUILE as the '%guile-for-build' parameter for the dynamic extent of | |
593 | EXP, a series of monadic expressions." | |
594 | (call-with-guile guile (lambda () | |
595 | (mbegin %store-monad exp ...)))) | |
596 | ||
42a87136 LC |
597 | (define (with-trivial-build-handler mvalue) |
598 | "Run MVALUE, a monadic value, with a \"trivial\" build handler installed | |
599 | that unconditionally resumes the continuation." | |
600 | (lambda (store) | |
601 | (with-build-handler (lambda (continue . _) | |
602 | (continue #t)) | |
603 | (values (run-with-store store mvalue) | |
604 | store)))) | |
605 | ||
0d39a3b9 | 606 | (define* (build-from-source name source |
acefa740 | 607 | #:key core verbose? commit |
0d39a3b9 LC |
608 | (dependencies '())) |
609 | "Return a derivation to build Guix from SOURCE, using the self-build script | |
acefa740 LC |
610 | contained therein; use COMMIT as the version string. When CORE is true, build |
611 | package modules under SOURCE using CORE, an instance of Guix." | |
0d39a3b9 LC |
612 | ;; Running the self-build script makes it easier to update the build |
613 | ;; procedure: the self-build script of the Guix-to-be-installed contains the | |
614 | ;; right dependencies, build procedure, etc., which the Guix-in-use may not | |
615 | ;; be know. | |
616 | (define script | |
617 | (string-append source "/" %self-build-file)) | |
618 | ||
619 | (if (file-exists? script) | |
620 | (let ((build (save-module-excursion | |
621 | (lambda () | |
3a8c4860 LC |
622 | ;; Disable deprecation warnings; it's OK for SCRIPT to |
623 | ;; use deprecated APIs and the user doesn't have to know | |
624 | ;; about it. | |
69962ab7 | 625 | (parameterize ((guix-warning-port |
3a8c4860 | 626 | (%make-void-port "w"))) |
37c0d458 LC |
627 | (primitive-load script))))) |
628 | (guile (guile-for-source source))) | |
0d39a3b9 LC |
629 | ;; BUILD must be a monadic procedure of at least one argument: the |
630 | ;; source tree. | |
631 | ;; | |
632 | ;; Note: BUILD can return #f if it does not support %PULL-VERSION. In | |
633 | ;; the future we'll fall back to a previous version of the protocol | |
634 | ;; when that happens. | |
9db88369 | 635 | (with-guile guile |
42a87136 LC |
636 | ;; BUILD is usually quite costly. Install a "trivial" build handler |
637 | ;; so we don't bounce an outer build-accumulator handler that could | |
638 | ;; cause us to redo half of the BUILD computation several times just | |
639 | ;; to realize it gives the same result. | |
640 | (with-trivial-build-handler | |
641 | (build source #:verbose? verbose? #:version commit | |
642 | #:pull-version %pull-version)))) | |
0d39a3b9 LC |
643 | |
644 | ;; Build a set of modules that extend Guix using the standard method. | |
acefa740 | 645 | (standard-module-derivation name source core dependencies))) |
0d39a3b9 | 646 | |
acefa740 LC |
647 | (define* (build-channel-instance instance |
648 | #:optional core (dependencies '())) | |
0d39a3b9 LC |
649 | "Return, as a monadic value, the derivation for INSTANCE, a channel |
650 | instance. DEPENDENCIES is a list of extensions providing Guile modules that | |
651 | INSTANCE depends on." | |
652 | (build-from-source (symbol->string | |
653 | (channel-name (channel-instance-channel instance))) | |
654 | (channel-instance-checkout instance) | |
655 | #:commit (channel-instance-commit instance) | |
acefa740 | 656 | #:core core |
0d39a3b9 LC |
657 | #:dependencies dependencies)) |
658 | ||
ed75bdf3 LC |
659 | (define (resolve-dependencies instances) |
660 | "Return a procedure that, given one of the elements of INSTANCES, returns | |
661 | list of instances it depends on." | |
662 | (define channel-instance-name | |
663 | (compose channel-name channel-instance-channel)) | |
664 | ||
665 | (define table ;map a name to an instance | |
666 | (fold (lambda (instance table) | |
667 | (vhash-consq (channel-instance-name instance) | |
668 | instance table)) | |
669 | vlist-null | |
670 | instances)) | |
671 | ||
672 | (define edges | |
673 | (fold (lambda (instance edges) | |
674 | (fold (lambda (channel edges) | |
675 | (let ((name (channel-name channel))) | |
676 | (match (vhash-assq name table) | |
677 | ((_ . target) | |
678 | (vhash-consq instance target edges))))) | |
679 | edges | |
680 | (channel-instance-dependencies instance))) | |
681 | vlist-null | |
682 | instances)) | |
683 | ||
684 | (lambda (instance) | |
685 | (vhash-foldq* cons '() instance edges))) | |
686 | ||
0d39a3b9 LC |
687 | (define (channel-instance-derivations instances) |
688 | "Return the list of derivations to build INSTANCES, in the same order as | |
689 | INSTANCES." | |
690 | (define core-instance | |
691 | ;; The 'guix' channel is treated specially: it's an implicit dependency of | |
692 | ;; all the other channels. | |
693 | (find (lambda (instance) | |
694 | (guix-channel? (channel-instance-channel instance))) | |
695 | instances)) | |
696 | ||
ed75bdf3 LC |
697 | (define edges |
698 | (resolve-dependencies instances)) | |
699 | ||
700 | (define (instance->derivation instance) | |
cdf68947 LC |
701 | (mlet %store-monad ((system (current-system))) |
702 | (mcached (if (eq? instance core-instance) | |
703 | (build-channel-instance instance) | |
704 | (mlet %store-monad ((core (instance->derivation core-instance)) | |
705 | (deps (mapm %store-monad instance->derivation | |
706 | (edges instance)))) | |
707 | (build-channel-instance instance core deps))) | |
708 | instance | |
709 | system))) | |
ed75bdf3 | 710 | |
ab6025b5 LC |
711 | (unless core-instance |
712 | (let ((loc (and=> (any (compose channel-location channel-instance-channel) | |
713 | instances) | |
714 | source-properties->location))) | |
715 | (raise (apply make-compound-condition | |
716 | (condition | |
717 | (&message (message "'guix' channel is lacking"))) | |
f75243e1 LC |
718 | (condition |
719 | (&fix-hint (hint (G_ "Make sure your list of channels | |
720 | contains one channel named @code{guix} providing the core of Guix.")))) | |
ab6025b5 LC |
721 | (if loc |
722 | (list (condition (&error-location (location loc)))) | |
723 | '()))))) | |
724 | ||
ed75bdf3 | 725 | (mapm %store-monad instance->derivation instances)) |
0d39a3b9 | 726 | |
0d39a3b9 LC |
727 | (define (whole-package-for-legacy name modules) |
728 | "Return a full-blown Guix package for MODULES, a derivation that builds Guix | |
729 | modules in the old ~/.config/guix/latest style." | |
730 | (define packages | |
731 | (resolve-interface '(gnu packages guile))) | |
732 | ||
49c35bbb LC |
733 | (define modules+compiled |
734 | ;; Since MODULES contains both .scm and .go files at its root, re-bundle | |
735 | ;; it so that it has share/guile/site and lib/guile, which is what | |
736 | ;; 'whole-package' expects. | |
737 | (computed-file (derivation-name modules) | |
738 | (with-imported-modules '((guix build utils)) | |
739 | #~(begin | |
740 | (use-modules (guix build utils)) | |
741 | ||
742 | (define version | |
743 | (effective-version)) | |
744 | (define share | |
745 | (string-append #$output "/share/guile/site")) | |
746 | (define lib | |
747 | (string-append #$output "/lib/guile/" version)) | |
748 | ||
749 | (mkdir-p share) (mkdir-p lib) | |
750 | (symlink #$modules (string-append share "/" version)) | |
751 | (symlink #$modules (string-append lib "/site-ccache")))))) | |
752 | ||
0d39a3b9 LC |
753 | (letrec-syntax ((list (syntax-rules (->) |
754 | ((_) | |
755 | '()) | |
756 | ((_ (module -> variable) rest ...) | |
757 | (cons (module-ref (resolve-interface | |
758 | '(gnu packages module)) | |
759 | 'variable) | |
760 | (list rest ...))) | |
761 | ((_ variable rest ...) | |
762 | (cons (module-ref packages 'variable) | |
763 | (list rest ...)))))) | |
49c35bbb | 764 | (whole-package name modules+compiled |
0d39a3b9 LC |
765 | |
766 | ;; In the "old style", %SELF-BUILD-FILE would simply return a | |
767 | ;; derivation that builds modules. We have to infer what the | |
768 | ;; dependencies of these modules were. | |
b74ed909 | 769 | (list guile-json-3 guile-git guile-bytestructures |
0d39a3b9 LC |
770 | (ssh -> guile-ssh) (tls -> gnutls))))) |
771 | ||
772 | (define (old-style-guix? drv) | |
773 | "Return true if DRV corresponds to a ~/.config/guix/latest style of | |
774 | derivation." | |
775 | ;; Here we rely on a gross historical fact: that derivations produced by the | |
776 | ;; "old style" (before commit 8a0d9bc8a3f153159d9e239a151c0fa98f1e12d8, | |
777 | ;; dated May 30, 2018) did not depend on "guix-command.drv". | |
778 | (not (find (lambda (input) | |
9af75a26 LC |
779 | (string=? "guix-command" |
780 | (derivation-name | |
781 | (derivation-input-derivation input)))) | |
0d39a3b9 LC |
782 | (derivation-inputs drv)))) |
783 | ||
784 | (define (channel-instances->manifest instances) | |
785 | "Return a profile manifest with entries for all of INSTANCES, a list of | |
786 | channel instances." | |
d9e6217f LC |
787 | (define (instance->entry instance drv) |
788 | (let ((commit (channel-instance-commit instance)) | |
789 | (channel (channel-instance-channel instance))) | |
790 | (manifest-entry | |
791 | (name (symbol->string (channel-name channel))) | |
792 | (version (string-take commit 7)) | |
793 | (item (if (guix-channel? channel) | |
794 | (if (old-style-guix? drv) | |
795 | (whole-package-for-legacy (string-append name "-" version) | |
796 | drv) | |
797 | drv) | |
798 | drv)) | |
799 | (properties | |
800 | `((source (repository | |
801 | (version 0) | |
802 | (url ,(channel-url channel)) | |
803 | (branch ,(channel-branch channel)) | |
804 | (commit ,commit)))))))) | |
0d39a3b9 LC |
805 | |
806 | (mlet* %store-monad ((derivations (channel-instance-derivations instances)) | |
d9e6217f | 807 | (entries -> (map instance->entry instances derivations))) |
0d39a3b9 | 808 | (return (manifest entries)))) |
030f1367 | 809 | |
5fbdc9a5 LC |
810 | (define (package-cache-file manifest) |
811 | "Build a package cache file for the instance in MANIFEST. This is meant to | |
812 | be used as a profile hook." | |
ccbc427f | 813 | (let ((profile (profile (content manifest) (hooks '())))) |
5fbdc9a5 LC |
814 | (define build |
815 | #~(begin | |
816 | (use-modules (gnu packages)) | |
817 | ||
818 | (if (defined? 'generate-package-cache) | |
819 | (begin | |
820 | ;; Delegate package cache generation to the inferior. | |
821 | (format (current-error-port) | |
822 | "Generating package cache for '~a'...~%" | |
823 | #$profile) | |
824 | (generate-package-cache #$output)) | |
825 | (mkdir #$output)))) | |
826 | ||
827 | (gexp->derivation-in-inferior "guix-package-cache" build | |
828 | profile | |
4035fcba LC |
829 | |
830 | ;; If the Guix in PROFILE is too old and | |
831 | ;; lacks 'guix repl', don't build the cache | |
832 | ;; instead of failing. | |
833 | #:silent-failure? #t | |
834 | ||
5fbdc9a5 | 835 | #:properties '((type . profile-hook) |
f674bc66 LC |
836 | (hook . package-cache)) |
837 | #:local-build? #t))) | |
5fbdc9a5 LC |
838 | |
839 | (define %channel-profile-hooks | |
840 | ;; The default channel profile hooks. | |
841 | (cons package-cache-file %default-profile-hooks)) | |
842 | ||
c37f38bd LC |
843 | (define (channel-instances->derivation instances) |
844 | "Return the derivation of the profile containing INSTANCES, a list of | |
845 | channel instances." | |
846 | (mlet %store-monad ((manifest (channel-instances->manifest instances))) | |
5fbdc9a5 LC |
847 | (profile-derivation manifest |
848 | #:hooks %channel-profile-hooks))) | |
c37f38bd | 849 | |
030f1367 LC |
850 | (define latest-channel-instances* |
851 | (store-lift latest-channel-instances)) | |
852 | ||
872898f7 LC |
853 | (define* (latest-channel-derivation #:optional (channels %default-channels) |
854 | #:key | |
855 | (current-channels '()) | |
856 | (validate-pull | |
857 | ensure-forward-channel-update)) | |
030f1367 | 858 | "Return as a monadic value the derivation that builds the profile for the |
872898f7 LC |
859 | latest instances of CHANNELS. CURRENT-CHANNELS and VALIDATE-PULL are passed |
860 | to 'latest-channel-instances'." | |
861 | (mlet %store-monad ((instances | |
862 | (latest-channel-instances* channels | |
863 | #:current-channels | |
864 | current-channels | |
865 | #:validate-pull | |
866 | validate-pull))) | |
c37f38bd | 867 | (channel-instances->derivation instances))) |
a7c714d3 LC |
868 | |
869 | (define (profile-channels profile) | |
870 | "Return the list of channels corresponding to entries in PROFILE. If | |
871 | PROFILE is not a profile created by 'guix pull', return the empty list." | |
872 | (filter-map (lambda (entry) | |
873 | (match (assq 'source (manifest-entry-properties entry)) | |
874 | (('source ('repository ('version 0) | |
875 | ('url url) | |
876 | ('branch branch) | |
877 | ('commit commit) | |
878 | _ ...)) | |
879 | (channel (name (string->symbol | |
880 | (manifest-entry-name entry))) | |
881 | (url url) | |
882 | (commit commit))) | |
883 | ||
884 | ;; No channel information for this manifest entry. | |
885 | ;; XXX: Pre-0.15.0 Guix did not provide that information, | |
886 | ;; but there's not much we can do in that case. | |
887 | (_ #f))) | |
888 | ||
889 | ;; Show most recently installed packages last. | |
890 | (reverse | |
891 | (manifest-entries (profile-manifest profile))))) | |
8ba7fd3c LC |
892 | |
893 | \f | |
894 | ;;; | |
895 | ;;; News. | |
896 | ;;; | |
897 | ||
898 | ;; Channel news. | |
899 | (define-record-type <channel-news> | |
900 | (channel-news entries) | |
901 | channel-news? | |
902 | (entries channel-news-entries)) ;list of <channel-news-entry> | |
903 | ||
904 | ;; News entry, associated with a specific commit of the channel. | |
905 | (define-record-type <channel-news-entry> | |
9719e8d3 | 906 | (channel-news-entry commit tag title body) |
8ba7fd3c | 907 | channel-news-entry? |
9719e8d3 LC |
908 | (commit channel-news-entry-commit) ;hex string | #f |
909 | (tag channel-news-entry-tag) ;#f | string | |
8ba7fd3c LC |
910 | (title channel-news-entry-title) ;list of language tag/string pairs |
911 | (body channel-news-entry-body)) ;list of language tag/string pairs | |
912 | ||
913 | (define (sexp->channel-news-entry entry) | |
914 | "Return the <channel-news-entry> record corresponding to ENTRY, an sexp." | |
915 | (define (pair language message) | |
916 | (cons (symbol->string language) message)) | |
917 | ||
918 | (match entry | |
9719e8d3 | 919 | (('entry ((and (or 'commit 'tag) type) commit-or-tag) |
8ba7fd3c LC |
920 | ('title ((? symbol? title-tags) (? string? titles)) ...) |
921 | ('body ((? symbol? body-tags) (? string? bodies)) ...) | |
922 | _ ...) | |
9719e8d3 LC |
923 | (channel-news-entry (and (eq? type 'commit) commit-or-tag) |
924 | (and (eq? type 'tag) commit-or-tag) | |
8ba7fd3c LC |
925 | (map pair title-tags titles) |
926 | (map pair body-tags bodies))) | |
927 | (_ | |
928 | (raise (condition | |
929 | (&message (message "invalid channel news entry")) | |
930 | (&error-location | |
931 | (location (source-properties->location | |
932 | (source-properties entry))))))))) | |
933 | ||
934 | (define (read-channel-news port) | |
935 | "Read a channel news feed from PORT and return it as a <channel-news> | |
936 | record." | |
937 | (match (false-if-exception (read port)) | |
938 | (('channel-news ('version 0) entries ...) | |
939 | (channel-news (map sexp->channel-news-entry entries))) | |
940 | (('channel-news ('version version) _ ...) | |
941 | ;; This is an unsupported version from the future. There's nothing wrong | |
942 | ;; with that (the user may simply need to upgrade the 'guix' channel to | |
943 | ;; be able to read it), so silently ignore it. | |
944 | (channel-news '())) | |
945 | (#f | |
946 | (raise (condition | |
947 | (&message (message "syntactically invalid channel news file"))))) | |
948 | (sexp | |
949 | (raise (condition | |
950 | (&message (message "invalid channel news file")) | |
951 | (&error-location | |
952 | (location (source-properties->location | |
953 | (source-properties sexp))))))))) | |
954 | ||
9719e8d3 LC |
955 | (define (resolve-channel-news-entry-tag repository entry) |
956 | "If ENTRY has its 'commit' field set, return ENTRY. Otherwise, lookup | |
957 | ENTRY's 'tag' in REPOSITORY and return ENTRY with its 'commit' field set to | |
958 | the field its 'tag' refers to. A 'git-error' exception is raised if the tag | |
959 | cannot be found." | |
960 | (if (channel-news-entry-commit entry) | |
961 | entry | |
962 | (let* ((tag (channel-news-entry-tag entry)) | |
963 | (reference (string-append "refs/tags/" tag)) | |
964 | (oid (reference-name->oid repository reference))) | |
965 | (channel-news-entry (oid->string oid) tag | |
966 | (channel-news-entry-title entry) | |
967 | (channel-news-entry-body entry))))) | |
968 | ||
8ba7fd3c LC |
969 | (define* (channel-news-for-commit channel new #:optional old) |
970 | "Return a list of <channel-news-entry> for CHANNEL between commits OLD and | |
971 | NEW. When OLD is omitted or is #f, return all the news entries of CHANNEL." | |
972 | (catch 'git-error | |
973 | (lambda () | |
974 | (let* ((checkout (update-cached-checkout (channel-url channel) | |
975 | #:ref `(commit . ,new))) | |
976 | (metadata (read-channel-metadata-from-source checkout)) | |
977 | (news-file (channel-metadata-news-file metadata)) | |
978 | (news-file (and news-file | |
979 | (string-append checkout "/" news-file)))) | |
980 | (if (and news-file (file-exists? news-file)) | |
9719e8d3 LC |
981 | (with-repository checkout repository |
982 | (let* ((news (call-with-input-file news-file | |
983 | read-channel-news)) | |
984 | (entries (map (lambda (entry) | |
985 | (resolve-channel-news-entry-tag repository | |
986 | entry)) | |
987 | (channel-news-entries news)))) | |
988 | (if old | |
8ba7fd3c LC |
989 | (let* ((new (commit-lookup repository (string->oid new))) |
990 | (old (commit-lookup repository (string->oid old))) | |
991 | (commits (list->set | |
992 | (map (compose oid->string commit-id) | |
993 | (commit-difference new old))))) | |
994 | (filter (lambda (entry) | |
995 | (set-contains? commits | |
996 | (channel-news-entry-commit entry))) | |
9719e8d3 LC |
997 | entries)) |
998 | entries))) | |
8ba7fd3c LC |
999 | '()))) |
1000 | (lambda (key error . rest) | |
1001 | ;; If commit NEW or commit OLD cannot be found, then something must be | |
1002 | ;; wrong (for example, the history of CHANNEL was rewritten and these | |
1003 | ;; commits no longer exist upstream), so quietly return the empty list. | |
1004 | (if (= GIT_ENOTFOUND (git-error-code error)) | |
1005 | '() | |
1006 | (apply throw key error rest))))) | |
9db88369 LC |
1007 | |
1008 | ;;; Local Variables: | |
1009 | ;;; eval: (put 'with-guile 'scheme-indent-function 1) | |
1010 | ;;; End: |