guix/build/profiles.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
   3 ;;;
   4 ;;; This file is part of GNU Guix.
   5 ;;;
   6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or (at
   9 ;;; your option) any later version.
  10 ;;;
  11 ;;; GNU Guix is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (define-module (guix build profiles)
  20   #:use-module (guix build union)
  21   #:use-module (guix build utils)
  22   #:use-module (guix search-paths)
  23   #:use-module (srfi srfi-26)
  24   #:use-module (ice-9 ftw)
  25   #:use-module (ice-9 match)
  26   #:use-module (ice-9 pretty-print)
  27   #:export (ensure-writable-directory
  28             build-profile))
  29
  30 ;;; Commentary:
  31 ;;;
  32 ;;; Build a user profile (essentially the union of all the installed packages)
  33 ;;; with its associated meta-data.
  34 ;;;
  35 ;;; Code:
  36
  37 (define (abstract-profile profile)
  38   "Return a procedure that replaces PROFILE in VALUE with a reference to the
  39 'GUIX_PROFILE' environment variable.  This allows users to specify what the
  40 user-friendly name of the profile is, for instance ~/.guix-profile rather than
  41 /gnu/store/...-profile."
  42   (let ((replacement (string-append "${GUIX_PROFILE:-" profile "}")))
  43     (match-lambda
  44       ((search-path . value)
  45        (let* ((separator (search-path-specification-separator search-path))
  46               (items     (string-tokenize* value separator))
  47               (crop      (cute string-drop <> (string-length profile))))
  48          (cons search-path
  49                (string-join (map (lambda (str)
  50                                    (string-append replacement (crop str)))
  51                                  items)
  52                             separator)))))))
  53
  54 (define (write-environment-variable-definition port)
  55   "Write the given environment variable definition to PORT."
  56   (match-lambda
  57     ((search-path . value)
  58      (display (search-path-definition search-path value #:kind 'prefix)
  59               port)
  60      (newline port))))
  61
  62 (define (build-etc/profile output search-paths)
  63   "Build the 'OUTPUT/etc/profile' shell file containing environment variable
  64 definitions for all the SEARCH-PATHS."
  65   (mkdir-p (string-append output "/etc"))
  66   (call-with-output-file (string-append output "/etc/profile")
  67     (lambda (port)
  68       ;; The use of $GUIX_PROFILE described below is not great.  Another
  69       ;; option would have been to use "$1" and have users run:
  70       ;;
  71       ;;   source ~/.guix-profile/etc/profile ~/.guix-profile
  72       ;;
  73       ;; However, when 'source' is used with no arguments, $1 refers to the
  74       ;; first positional parameter of the calling scripts, so we can rely on
  75       ;; it.
  76       (display "\
  77 # Source this file to define all the relevant environment variables in Bash
  78 # for this profile.  You may want to define the 'GUIX_PROFILE' environment
  79 # variable to point to the \"visible\" name of the profile, like this:
  80 #
  81 #  GUIX_PROFILE=/path/to/profile
  82 #  source /path/to/profile/etc/profile
  83 #
  84 # When GUIX_PROFILE is undefined, the various environment variables refer
  85 # to this specific profile generation.
  86 \n" port)
  87       (let ((variables (evaluate-search-paths (cons $PATH search-paths)
  88                                               (list output))))
  89         (for-each (write-environment-variable-definition port)
  90                   (map (abstract-profile output) variables))))))
  91
  92 (define (ensure-writable-directory directory)
  93   "Ensure DIRECTORY exists and is writable.  If DIRECTORY is currently a
  94 symlink (to a read-only directory in the store), then delete the symlink and
  95 instead make DIRECTORY a \"real\" directory containing symlinks."
  96   (define (unsymlink link)
  97     (let* ((target (readlink link))
  98            ;; TARGET might itself be a symlink, so append "/" to make sure
  99            ;; 'scandir' enters it.
 100            (files  (scandir (string-append target "/")
 101                             (negate (cut member <> '("." ".."))))))
 102       (delete-file link)
 103       (mkdir link)
 104       (for-each (lambda (file)
 105                   (symlink (string-append target "/" file)
 106                            (string-append link "/" file)))
 107                 files)))
 108
 109   (catch 'system-error
 110     (lambda ()
 111       (mkdir directory))
 112     (lambda args
 113       (let ((errno (system-error-errno args)))
 114         (if (= errno EEXIST)
 115             (let ((stat (lstat directory)))
 116               (case (stat:type stat)
 117                 ((symlink)
 118                  ;; "Unsymlink" DIRECTORY so that it is writable.
 119                  (unsymlink directory))
 120                 ((directory)
 121                  #t)
 122                 (else
 123                  (error "cannot mkdir because a same-named file exists"
 124                         directory))))
 125             (apply throw args))))))
 126
 127 (define* (build-profile output inputs
 128                         #:key manifest search-paths)
 129   "Build a user profile from INPUTS in directory OUTPUT.  Write MANIFEST, an
 130 sexp, to OUTPUT/manifest.  Create OUTPUT/etc/profile with Bash definitions for
 131 -all the variables listed in SEARCH-PATHS."
 132   ;; Make the symlinks.
 133   (union-build output inputs
 134                #:log-port (%make-void-port "w"))
 135
 136   ;; Store meta-data.
 137   (call-with-output-file (string-append output "/manifest")
 138     (lambda (p)
 139       (pretty-print manifest p)))
 140
 141   ;; Make sure we can write to 'OUTPUT/etc'.  'union-build' above could have
 142   ;; made 'etc' a symlink to a read-only sub-directory in the store so we need
 143   ;; to work around that.
 144   (ensure-writable-directory (string-append output "/etc"))
 145
 146   ;; Write 'OUTPUT/etc/profile'.
 147   (build-etc/profile output search-paths))
 148
 149 ;;; profile.scm ends here