123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188 |
- (define-module (guix build profiles)
- #:use-module (guix build union)
- #:use-module (guix build utils)
- #:use-module (guix search-paths)
- #:use-module (srfi srfi-26)
- #:use-module (ice-9 ftw)
- #:use-module (ice-9 match)
- #:use-module (ice-9 pretty-print)
- #:re-export (symlink-relative)
- #:export (ensure-writable-directory
- build-profile))
- (define (abstract-profile profile)
- "Return a procedure that replaces PROFILE in VALUE with a reference to the
- 'GUIX_PROFILE' environment variable. This allows users to specify what the
- user-friendly name of the profile is, for instance ~/.guix-profile rather than
- /gnu/store/...-profile."
- (let ((replacement (string-append "${GUIX_PROFILE:-" profile "}"))
- (crop (cute string-drop <> (string-length profile))))
- (match-lambda
- ((search-path . value)
- (match (search-path-specification-separator search-path)
- (#f
- (cons search-path
- (string-append replacement (crop value))))
- ((? string? separator)
- (let ((items (string-tokenize* value separator)))
- (cons search-path
- (string-join (map (lambda (str)
- (string-append replacement (crop str)))
- items)
- separator)))))))))
- (define (write-environment-variable-definition port)
- "Write the given environment variable definition to PORT."
- (match-lambda
- ((search-path . value)
- (display (search-path-definition search-path value #:kind 'prefix)
- port)
- (newline port))))
- (define (build-etc/profile output search-paths)
- "Build the 'OUTPUT/etc/profile' shell file containing environment variable
- definitions for all the SEARCH-PATHS."
- (define file
- (string-append output "/etc/profile"))
- (mkdir-p (dirname file))
- (when (file-exists? file)
- (delete-file file))
- (call-with-output-file file
- (lambda (port)
-
-
-
-
-
-
-
-
- (display "\
- # Source this file to define all the relevant environment variables in Bash
- # for this profile. You may want to define the 'GUIX_PROFILE' environment
- # variable to point to the \"visible\" name of the profile, like this:
- #
- # GUIX_PROFILE=/path/to/profile ; \\
- # source /path/to/profile/etc/profile
- #
- # When GUIX_PROFILE is undefined, the various environment variables refer
- # to this specific profile generation.
- \n" port)
- (let ((variables (evaluate-search-paths search-paths
- (list output))))
- (for-each (write-environment-variable-definition port)
- (map (abstract-profile output) variables))))))
- (define* (ensure-writable-directory directory
- #:key (symlink symlink))
- "Ensure DIRECTORY exists and is writable. If DIRECTORY is currently a
- symlink (to a read-only directory in the store), then delete the symlink and
- instead make DIRECTORY a \"real\" directory containing symlinks."
- (define (absolute? file)
- (string-prefix? "/" file))
- (define (unsymlink link)
- (let* ((target (match (readlink link)
- ((? absolute? target)
- target)
- ((? string? relative)
- (string-append (dirname link) "/" relative))))
-
-
- (files (scandir (string-append target "/")
- (negate (cut member <> '("." ".."))))))
- (delete-file link)
- (mkdir link)
- (for-each (lambda (file)
- (symlink (string-append target "/" file)
- (string-append link "/" file)))
- files)))
- (catch 'system-error
- (lambda ()
- (mkdir directory))
- (lambda args
- (let ((errno (system-error-errno args)))
- (if (= errno EEXIST)
- (let ((stat (lstat directory)))
- (case (stat:type stat)
- ((symlink)
-
- (unsymlink directory))
- ((directory)
- #t)
- (else
- (error "cannot mkdir because a same-named file exists"
- directory))))
- (apply throw args))))))
- (define* (build-profile output inputs
- #:key manifest search-paths
- (symlink symlink))
- "Build a user profile from INPUTS in directory OUTPUT, using SYMLINK to
- create symlinks. Write MANIFEST, an sexp, to OUTPUT/manifest. Create
- OUTPUT/etc/profile with Bash definitions for -all the variables listed in
- SEARCH-PATHS."
- (define manifest-file
- (string-append output "/manifest"))
-
- (union-build output inputs
- #:symlink symlink
- #:log-port (%make-void-port "w"))
-
-
-
- (when (file-exists? manifest-file)
- (delete-file manifest-file))
-
- (call-with-output-file manifest-file
- (lambda (p)
- (display "\
- ;; This file was automatically generated and is for internal use only.
- ;; It cannot be passed to the '--manifest' option.
- ;; Run 'guix package --export-manifest' if you want to export a file
- ;; suitable for '--manifest'.\n\n"
- p)
- (pretty-print manifest p)))
-
-
-
- (ensure-writable-directory (string-append output "/etc")
- #:symlink symlink)
-
- (build-etc/profile output search-paths))
|