Merge branch 'core-updates'
[jackhill/guix/guix.git] / guix / profiles.scm
CommitLineData
cc4ecc2d 1;;; GNU Guix --- Functional package management for GNU
e87f0591 2;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
cc4ecc2d 3;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
343745c8 4;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
536c3ee4 5;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
cc4ecc2d
LC
6;;;
7;;; This file is part of GNU Guix.
8;;;
9;;; GNU Guix is free software; you can redistribute it and/or modify it
10;;; under the terms of the GNU General Public License as published by
11;;; the Free Software Foundation; either version 3 of the License, or (at
12;;; your option) any later version.
13;;;
14;;; GNU Guix is distributed in the hope that it will be useful, but
15;;; WITHOUT ANY WARRANTY; without even the implied warranty of
16;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17;;; GNU General Public License for more details.
18;;;
19;;; You should have received a copy of the GNU General Public License
20;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
21
22(define-module (guix profiles)
23 #:use-module (guix utils)
24 #:use-module (guix records)
25 #:use-module (guix derivations)
26 #:use-module (guix packages)
a54c94a4 27 #:use-module (guix gexp)
79ee406d 28 #:use-module (guix monads)
e87f0591 29 #:use-module (guix store)
cc4ecc2d
LC
30 #:use-module (ice-9 match)
31 #:use-module (ice-9 regex)
32 #:use-module (ice-9 ftw)
343745c8 33 #:use-module (ice-9 format)
cc4ecc2d
LC
34 #:use-module (srfi srfi-1)
35 #:use-module (srfi srfi-9)
79601521 36 #:use-module (srfi srfi-11)
cc4ecc2d
LC
37 #:use-module (srfi srfi-19)
38 #:use-module (srfi srfi-26)
c0c018f1
AK
39 #:use-module (srfi srfi-34)
40 #:use-module (srfi srfi-35)
41 #:export (&profile-error
42 profile-error?
43 profile-error-profile
44 &profile-not-found-error
45 profile-not-found-error?
46 &missing-generation-error
47 missing-generation-error?
48 missing-generation-error-generation
49
50 manifest make-manifest
cc4ecc2d
LC
51 manifest?
52 manifest-entries
53
54 <manifest-entry> ; FIXME: eventually make it internal
55 manifest-entry
56 manifest-entry?
57 manifest-entry-name
58 manifest-entry-version
59 manifest-entry-output
a54c94a4 60 manifest-entry-item
cc4ecc2d
LC
61 manifest-entry-dependencies
62
a2078770
LC
63 manifest-pattern
64 manifest-pattern?
65
cc4ecc2d 66 manifest-remove
f7554030 67 manifest-add
ef8993e2 68 manifest-lookup
cc4ecc2d 69 manifest-installed?
a2078770 70 manifest-matching-entries
cc4ecc2d 71
343745c8
AK
72 manifest-transaction
73 manifest-transaction?
74 manifest-transaction-install
75 manifest-transaction-remove
76 manifest-perform-transaction
79601521 77 manifest-transaction-effects
343745c8 78
cc4ecc2d 79 profile-manifest
462f5cca 80 package->manifest-entry
aa46a028 81 %default-profile-hooks
cc4ecc2d
LC
82 profile-derivation
83 generation-number
84 generation-numbers
f452e8ff 85 profile-generations
3ccde087 86 relative-generation
cc4ecc2d
LC
87 previous-generation-number
88 generation-time
89 generation-file-name))
90
91;;; Commentary:
92;;;
93;;; Tools to create and manipulate profiles---i.e., the representation of a
94;;; set of installed packages.
95;;;
96;;; Code:
97
98\f
c0c018f1
AK
99;;;
100;;; Condition types.
101;;;
102
103(define-condition-type &profile-error &error
104 profile-error?
105 (profile profile-error-profile))
106
107(define-condition-type &profile-not-found-error &profile-error
108 profile-not-found-error?)
109
110(define-condition-type &missing-generation-error &profile-error
111 missing-generation-error?
112 (generation missing-generation-error-generation))
113
114\f
cc4ecc2d
LC
115;;;
116;;; Manifests.
117;;;
118
119(define-record-type <manifest>
120 (manifest entries)
121 manifest?
122 (entries manifest-entries)) ; list of <manifest-entry>
123
124;; Convenient alias, to avoid name clashes.
125(define make-manifest manifest)
126
127(define-record-type* <manifest-entry> manifest-entry
128 make-manifest-entry
129 manifest-entry?
130 (name manifest-entry-name) ; string
131 (version manifest-entry-version) ; string
132 (output manifest-entry-output ; string
133 (default "out"))
a54c94a4 134 (item manifest-entry-item) ; package | store path
4ca0b410
LC
135 (dependencies manifest-entry-dependencies ; (store path | package)*
136 (default '())))
cc4ecc2d 137
a2078770
LC
138(define-record-type* <manifest-pattern> manifest-pattern
139 make-manifest-pattern
140 manifest-pattern?
141 (name manifest-pattern-name) ; string
142 (version manifest-pattern-version ; string | #f
143 (default #f))
144 (output manifest-pattern-output ; string | #f
145 (default "out")))
146
cc4ecc2d
LC
147(define (profile-manifest profile)
148 "Return the PROFILE's manifest."
149 (let ((file (string-append profile "/manifest")))
150 (if (file-exists? file)
151 (call-with-input-file file read-manifest)
152 (manifest '()))))
153
462f5cca
LC
154(define* (package->manifest-entry package #:optional output)
155 "Return a manifest entry for the OUTPUT of package PACKAGE. When OUTPUT is
156omitted or #f, use the first output of PACKAGE."
157 (let ((deps (map (match-lambda
158 ((label package)
b4a4bec0 159 (gexp-input package))
462f5cca 160 ((label package output)
b4a4bec0 161 (gexp-input package output)))
462f5cca
LC
162 (package-transitive-propagated-inputs package))))
163 (manifest-entry
164 (name (package-name package))
165 (version (package-version package))
166 (output (or output (car (package-outputs package))))
167 (item package)
168 (dependencies (delete-duplicates deps)))))
169
a54c94a4
LC
170(define (manifest->gexp manifest)
171 "Return a representation of MANIFEST as a gexp."
172 (define (entry->gexp entry)
cc4ecc2d 173 (match entry
a54c94a4
LC
174 (($ <manifest-entry> name version output (? string? path) (deps ...))
175 #~(#$name #$version #$output #$path #$deps))
176 (($ <manifest-entry> name version output (? package? package) (deps ...))
177 #~(#$name #$version #$output
178 (ungexp package (or output "out")) #$deps))))
cc4ecc2d
LC
179
180 (match manifest
181 (($ <manifest> (entries ...))
a54c94a4
LC
182 #~(manifest (version 1)
183 (packages #$(map entry->gexp entries))))))
cc4ecc2d
LC
184
185(define (sexp->manifest sexp)
186 "Parse SEXP as a manifest."
187 (match sexp
188 (('manifest ('version 0)
189 ('packages ((name version output path) ...)))
190 (manifest
191 (map (lambda (name version output path)
192 (manifest-entry
193 (name name)
194 (version version)
195 (output output)
a54c94a4 196 (item path)))
cc4ecc2d
LC
197 name version output path)))
198
199 ;; Version 1 adds a list of propagated inputs to the
200 ;; name/version/output/path tuples.
201 (('manifest ('version 1)
202 ('packages ((name version output path deps) ...)))
203 (manifest
204 (map (lambda (name version output path deps)
d34736c5
LC
205 ;; Up to Guix 0.7 included, dependencies were listed as ("gmp"
206 ;; "/gnu/store/...-gmp") for instance. Discard the 'label' in
207 ;; such lists.
208 (let ((deps (match deps
209 (((labels directories) ...)
210 directories)
211 ((directories ...)
212 directories))))
213 (manifest-entry
214 (name name)
215 (version version)
216 (output output)
217 (item path)
218 (dependencies deps))))
cc4ecc2d
LC
219 name version output path deps)))
220
221 (_
222 (error "unsupported manifest format" manifest))))
223
224(define (read-manifest port)
225 "Return the packages listed in MANIFEST."
226 (sexp->manifest (read port)))
227
a2078770
LC
228(define (entry-predicate pattern)
229 "Return a procedure that returns #t when passed a manifest entry that
230matches NAME/OUTPUT/VERSION. OUTPUT and VERSION may be #f, in which case they
231are ignored."
232 (match pattern
233 (($ <manifest-pattern> name version output)
234 (match-lambda
235 (($ <manifest-entry> entry-name entry-version entry-output)
236 (and (string=? entry-name name)
237 (or (not entry-output) (not output)
238 (string=? entry-output output))
239 (or (not version)
240 (string=? entry-version version))))))))
241
242(define (manifest-remove manifest patterns)
243 "Remove entries for each of PATTERNS from MANIFEST. Each item in PATTERNS
244must be a manifest-pattern."
245 (define (remove-entry pattern lst)
246 (remove (entry-predicate pattern) lst))
247
248 (make-manifest (fold remove-entry
cc4ecc2d 249 (manifest-entries manifest)
a2078770 250 patterns)))
cc4ecc2d 251
f7554030
AK
252(define (manifest-add manifest entries)
253 "Add a list of manifest ENTRIES to MANIFEST and return new manifest.
254Remove MANIFEST entries that have the same name and output as ENTRIES."
255 (define (same-entry? entry name output)
256 (match entry
257 (($ <manifest-entry> entry-name _ entry-output _ ...)
258 (and (equal? name entry-name)
259 (equal? output entry-output)))))
260
261 (make-manifest
262 (append entries
263 (fold (lambda (entry result)
264 (match entry
265 (($ <manifest-entry> name _ out _ ...)
266 (filter (negate (cut same-entry? <> name out))
267 result))))
268 (manifest-entries manifest)
269 entries))))
270
ef8993e2
LC
271(define (manifest-lookup manifest pattern)
272 "Return the first item of MANIFEST that matches PATTERN, or #f if there is
273no match.."
274 (find (entry-predicate pattern)
275 (manifest-entries manifest)))
276
a2078770
LC
277(define (manifest-installed? manifest pattern)
278 "Return #t if MANIFEST has an entry matching PATTERN (a manifest-pattern),
279#f otherwise."
ef8993e2 280 (->bool (manifest-lookup manifest pattern)))
cc4ecc2d 281
a2078770
LC
282(define (manifest-matching-entries manifest patterns)
283 "Return all the entries of MANIFEST that match one of the PATTERNS."
284 (define predicates
285 (map entry-predicate patterns))
286
287 (define (matches? entry)
288 (any (lambda (pred)
289 (pred entry))
290 predicates))
291
292 (filter matches? (manifest-entries manifest)))
293
cc4ecc2d 294\f
343745c8
AK
295;;;
296;;; Manifest transactions.
297;;;
298
299(define-record-type* <manifest-transaction> manifest-transaction
300 make-manifest-transaction
301 manifest-transaction?
302 (install manifest-transaction-install ; list of <manifest-entry>
303 (default '()))
304 (remove manifest-transaction-remove ; list of <manifest-pattern>
305 (default '())))
306
79601521 307(define (manifest-transaction-effects manifest transaction)
46b23e1a
LC
308 "Compute the effect of applying TRANSACTION to MANIFEST. Return 4 values:
309the list of packages that would be removed, installed, upgraded, or downgraded
310when applying TRANSACTION to MANIFEST. Upgrades are represented as pairs
311where the head is the entry being upgraded and the tail is the entry that will
312replace it."
79601521
LC
313 (define (manifest-entry->pattern entry)
314 (manifest-pattern
315 (name (manifest-entry-name entry))
316 (output (manifest-entry-output entry))))
317
46b23e1a
LC
318 (let loop ((input (manifest-transaction-install transaction))
319 (install '())
320 (upgrade '())
321 (downgrade '()))
79601521
LC
322 (match input
323 (()
324 (let ((remove (manifest-transaction-remove transaction)))
325 (values (manifest-matching-entries manifest remove)
46b23e1a 326 (reverse install) (reverse upgrade) (reverse downgrade))))
79601521
LC
327 ((entry rest ...)
328 ;; Check whether installing ENTRY corresponds to the installation of a
329 ;; new package or to an upgrade.
330
331 ;; XXX: When the exact same output directory is installed, we're not
332 ;; really upgrading anything. Add a check for that case.
333 (let* ((pattern (manifest-entry->pattern entry))
46b23e1a
LC
334 (previous (manifest-lookup manifest pattern))
335 (newer? (and previous
3bea13bb
LC
336 (version>=? (manifest-entry-version entry)
337 (manifest-entry-version previous)))))
79601521 338 (loop rest
ef8993e2 339 (if previous install (cons entry install))
46b23e1a 340 (if (and previous newer?)
ef8993e2 341 (alist-cons previous entry upgrade)
46b23e1a
LC
342 upgrade)
343 (if (and previous (not newer?))
344 (alist-cons previous entry downgrade)
345 downgrade)))))))
79601521 346
343745c8
AK
347(define (manifest-perform-transaction manifest transaction)
348 "Perform TRANSACTION on MANIFEST and return new manifest."
349 (let ((install (manifest-transaction-install transaction))
350 (remove (manifest-transaction-remove transaction)))
351 (manifest-add (manifest-remove manifest remove)
352 install)))
353
343745c8 354\f
cc4ecc2d
LC
355;;;
356;;; Profiles.
357;;;
358
79ee406d 359(define (manifest-inputs manifest)
b4a4bec0 360 "Return a list of <gexp-input> objects for MANIFEST."
79ee406d 361 (append-map (match-lambda
b4a4bec0
LC
362 (($ <manifest-entry> name version output thing deps)
363 ;; THING may be a package or a file name. In the latter case,
364 ;; assume it's already valid. Ditto for DEPS.
365 (cons (gexp-input thing output) deps)))
79ee406d
LC
366 (manifest-entries manifest)))
367
368(define (info-dir-file manifest)
369 "Return a derivation that builds the 'dir' file for all the entries of
370MANIFEST."
2f0556ae
LC
371 (define texinfo ;lazy reference
372 (module-ref (resolve-interface '(gnu packages texinfo)) 'texinfo))
373 (define gzip ;lazy reference
374 (module-ref (resolve-interface '(gnu packages compression)) 'gzip))
375
79ee406d 376 (define build
a54c94a4 377 #~(begin
79ee406d
LC
378 (use-modules (guix build utils)
379 (srfi srfi-1) (srfi srfi-26)
380 (ice-9 ftw))
381
382 (define (info-file? file)
383 (or (string-suffix? ".info" file)
384 (string-suffix? ".info.gz" file)))
385
386 (define (info-files top)
387 (let ((infodir (string-append top "/share/info")))
388 (map (cut string-append infodir "/" <>)
c2815c0f 389 (or (scandir infodir info-file?) '()))))
79ee406d
LC
390
391 (define (install-info info)
2f0556ae 392 (setenv "PATH" (string-append #+gzip "/bin")) ;for info.gz files
79ee406d
LC
393 (zero?
394 (system* (string-append #+texinfo "/bin/install-info")
395 info (string-append #$output "/share/info/dir"))))
396
397 (mkdir-p (string-append #$output "/share/info"))
398 (every install-info
399 (append-map info-files
400 '#$(manifest-inputs manifest)))))
401
aa46a028
LC
402 (gexp->derivation "info-dir" build
403 #:modules '((guix build utils))))
79ee406d 404
042bc828
FB
405(define (ghc-package-cache-file manifest)
406 "Return a derivation that builds the GHC 'package.cache' file for all the
aa46a028 407entries of MANIFEST, or #f if MANIFEST does not have any GHC packages."
042bc828
FB
408 (define ghc ;lazy reference
409 (module-ref (resolve-interface '(gnu packages haskell)) 'ghc))
410
411 (define build
412 #~(begin
413 (use-modules (guix build utils)
414 (srfi srfi-1) (srfi srfi-26)
415 (ice-9 ftw))
416
417 (define ghc-name-version
418 (let* ((base (basename #+ghc)))
419 (string-drop base
420 (+ 1 (string-index base #\-)))))
421
422 (define db-subdir
423 (string-append "lib/" ghc-name-version "/package.conf.d"))
424
425 (define db-dir
426 (string-append #$output "/" db-subdir))
427
428 (define (conf-files top)
429 (find-files (string-append top "/" db-subdir) "\\.conf$"))
430
431 (define (copy-conf-file conf)
432 (let ((base (basename conf)))
433 (copy-file conf (string-append db-dir "/" base))))
434
435 (system* (string-append #+ghc "/bin/ghc-pkg") "init" db-dir)
436 (for-each copy-conf-file
437 (append-map conf-files
438 '#$(manifest-inputs manifest)))
439 (let ((success
440 (zero?
441 (system* (string-append #+ghc "/bin/ghc-pkg") "recache"
442 (string-append "--package-db=" db-dir)))))
443 (for-each delete-file (find-files db-dir "\\.conf$"))
444 success)))
445
446 ;; Don't depend on GHC when there's nothing to do.
aa46a028
LC
447 (and (any (cut string-prefix? "ghc" <>)
448 (map manifest-entry-name (manifest-entries manifest)))
449 (gexp->derivation "ghc-package-cache" build
450 #:modules '((guix build utils))
451 #:local-build? #t)))
042bc828 452
536c3ee4
MW
453(define (ca-certificate-bundle manifest)
454 "Return a derivation that builds a single-file bundle containing the CA
455certificates in the /etc/ssl/certs sub-directories of the packages in
456MANIFEST. Single-file bundles are required by programs such as Git and Lynx."
457 ;; See <http://lists.gnu.org/archive/html/guix-devel/2015-02/msg00429.html>
458 ;; for a discussion.
459
460 (define glibc-utf8-locales ;lazy reference
461 (module-ref (resolve-interface '(gnu packages base)) 'glibc-utf8-locales))
462
463 (define build
464 #~(begin
465 (use-modules (guix build utils)
466 (rnrs io ports)
467 (srfi srfi-1)
468 (srfi srfi-26)
c568191a
LC
469 (ice-9 ftw)
470 (ice-9 match))
536c3ee4
MW
471
472 (define (pem-file? file)
473 (string-suffix? ".pem" file))
474
475 (define (ca-files top)
476 (let ((cert-dir (string-append top "/etc/ssl/certs")))
477 (map (cut string-append cert-dir "/" <>)
478 (or (scandir cert-dir pem-file?) '()))))
479
480 (define (concatenate-files files result)
481 "Make RESULT the concatenation of all of FILES."
482 (define (dump file port)
483 (display (call-with-input-file file get-string-all)
484 port)
485 (newline port)) ;required, see <https://bugs.debian.org/635570>
486
487 (call-with-output-file result
488 (lambda (port)
489 (for-each (cut dump <> port) files))))
490
491 ;; Some file names in the NSS certificates are UTF-8 encoded so
492 ;; install a UTF-8 locale.
493 (setenv "LOCPATH" (string-append #+glibc-utf8-locales "/lib/locale"))
494 (setlocale LC_ALL "en_US.UTF-8")
495
c568191a
LC
496 (match (append-map ca-files '#$(manifest-inputs manifest))
497 (()
498 ;; Since there are no CA files, just create an empty directory. Do
499 ;; not create the etc/ssl/certs sub-directory, since that would
500 ;; wrongfully lead to a message about 'SSL_CERT_DIR' needing to be
501 ;; defined.
502 (mkdir #$output)
503 #t)
504 ((ca-files ...)
505 (let ((result (string-append #$output "/etc/ssl/certs")))
506 (mkdir-p result)
507 (concatenate-files ca-files
508 (string-append result
509 "/ca-certificates.crt"))
510 #t)))))
536c3ee4 511
aa46a028
LC
512 (gexp->derivation "ca-certificate-bundle" build
513 #:modules '((guix build utils))
514 #:local-build? #t))
515
516(define %default-profile-hooks
517 ;; This is the list of derivation-returning procedures that are called by
518 ;; default when making a non-empty profile.
519 (list info-dir-file
520 ghc-package-cache-file
521 ca-certificate-bundle))
536c3ee4
MW
522
523(define* (profile-derivation manifest
524 #:key
aa46a028 525 (hooks %default-profile-hooks))
79ee406d 526 "Return a derivation that builds a profile (aka. 'user environment') with
aa46a028
LC
527the given MANIFEST. The profile includes additional derivations returned by
528the monadic procedures listed in HOOKS--such as an Info 'dir' file, etc."
529 (mlet %store-monad ((extras (if (null? (manifest-entries manifest))
530 (return '())
531 (sequence %store-monad
532 (filter-map (lambda (hook)
533 (hook manifest))
534 hooks)))))
79ee406d 535 (define inputs
aa46a028 536 (append (map gexp-input extras)
536c3ee4 537 (manifest-inputs manifest)))
79ee406d
LC
538
539 (define builder
540 #~(begin
541 (use-modules (ice-9 pretty-print)
542 (guix build union))
543
544 (setvbuf (current-output-port) _IOLBF)
545 (setvbuf (current-error-port) _IOLBF)
546
547 (union-build #$output '#$inputs
548 #:log-port (%make-void-port "w"))
549 (call-with-output-file (string-append #$output "/manifest")
550 (lambda (p)
551 (pretty-print '#$(manifest->gexp manifest) p)))))
552
553 (gexp->derivation "profile" builder
554 #:modules '((guix build union))
555 #:local-build? #t)))
cc4ecc2d
LC
556
557(define (profile-regexp profile)
558 "Return a regular expression that matches PROFILE's name and number."
559 (make-regexp (string-append "^" (regexp-quote (basename profile))
560 "-([0-9]+)")))
561
562(define (generation-number profile)
563 "Return PROFILE's number or 0. An absolute file name must be used."
564 (or (and=> (false-if-exception (regexp-exec (profile-regexp profile)
565 (basename (readlink profile))))
566 (compose string->number (cut match:substring <> 1)))
567 0))
568
569(define (generation-numbers profile)
570 "Return the sorted list of generation numbers of PROFILE, or '(0) if no
571former profiles were found."
572 (define* (scandir name #:optional (select? (const #t))
573 (entry<? (@ (ice-9 i18n) string-locale<?)))
574 ;; XXX: Bug-fix version introduced in Guile v2.0.6-62-g139ce19.
575 (define (enter? dir stat result)
576 (and stat (string=? dir name)))
577
578 (define (visit basename result)
579 (if (select? basename)
580 (cons basename result)
581 result))
582
583 (define (leaf name stat result)
584 (and result
585 (visit (basename name) result)))
586
587 (define (down name stat result)
588 (visit "." '()))
589
590 (define (up name stat result)
591 (visit ".." result))
592
593 (define (skip name stat result)
594 ;; All the sub-directories are skipped.
595 (visit (basename name) result))
596
597 (define (error name* stat errno result)
598 (if (string=? name name*) ; top-level NAME is unreadable
599 result
600 (visit (basename name*) result)))
601
602 (and=> (file-system-fold enter? leaf down up skip error #f name lstat)
603 (lambda (files)
604 (sort files entry<?))))
605
606 (match (scandir (dirname profile)
607 (cute regexp-exec (profile-regexp profile) <>))
608 (#f ; no profile directory
609 '(0))
610 (() ; no profiles
611 '(0))
612 ((profiles ...) ; former profiles around
613 (sort (map (compose string->number
614 (cut match:substring <> 1)
615 (cute regexp-exec (profile-regexp profile) <>))
616 profiles)
617 <))))
618
f452e8ff
AK
619(define (profile-generations profile)
620 "Return a list of PROFILE's generations."
621 (let ((generations (generation-numbers profile)))
622 (if (equal? generations '(0))
623 '()
624 generations)))
625
3ccde087
AK
626(define* (relative-generation profile shift #:optional
627 (current (generation-number profile)))
628 "Return PROFILE's generation shifted from the CURRENT generation by SHIFT.
629SHIFT is a positive or negative number.
630Return #f if there is no such generation."
631 (let* ((abs-shift (abs shift))
632 (numbers (profile-generations profile))
633 (from-current (memq current
634 (if (negative? shift)
635 (reverse numbers)
636 numbers))))
637 (and from-current
638 (< abs-shift (length from-current))
639 (list-ref from-current abs-shift))))
640
641(define* (previous-generation-number profile #:optional
642 (number (generation-number profile)))
cc4ecc2d
LC
643 "Return the number of the generation before generation NUMBER of
644PROFILE, or 0 if none exists. It could be NUMBER - 1, but it's not the
645case when generations have been deleted (there are \"holes\")."
3ccde087
AK
646 (or (relative-generation profile -1 number)
647 0))
cc4ecc2d
LC
648
649(define (generation-file-name profile generation)
650 "Return the file name for PROFILE's GENERATION."
651 (format #f "~a-~a-link" profile generation))
652
653(define (generation-time profile number)
654 "Return the creation time of a generation in the UTC format."
655 (make-time time-utc 0
656 (stat:ctime (stat (generation-file-name profile number)))))
657
658;;; profiles.scm ends here