system: Add (guix build activation).

* gnu/services/dmd.scm (dmd-configuration-file): Remove 'etc'
  parameter.  Move /etc activation code to...
* guix/build/activation.scm: ... here; new file.
* gnu/system.scm (operating-system-boot-script): Augment script: add
  (guix build activation) to the load path; call 'activate-etc'.
* Makefile.am (MODULES): Add guix/build/activation.scm.
This commit is contained in:
Ludovic Courtès 2014-04-30 15:44:59 +02:00
parent 864068e204
commit 4dfe6c58ee
4 changed files with 84 additions and 28 deletions

View File

@ -71,6 +71,7 @@ MODULES = \
guix/build/rpath.scm \ guix/build/rpath.scm \
guix/build/svn.scm \ guix/build/svn.scm \
guix/build/vm.scm \ guix/build/vm.scm \
guix/build/activation.scm \
guix/packages.scm \ guix/packages.scm \
guix/snix.scm \ guix/snix.scm \
guix/scripts/download.scm \ guix/scripts/download.scm \

View File

@ -30,9 +30,8 @@
;;; ;;;
;;; Code: ;;; Code:
(define (dmd-configuration-file services etc) (define (dmd-configuration-file services)
"Return the dmd configuration file for SERVICES, that initializes /etc from "Return the dmd configuration file for SERVICES."
ETC (the derivation that builds the /etc directory) on startup."
(define config (define config
#~(begin #~(begin
(use-modules (ice-9 ftw)) (use-modules (ice-9 ftw))
@ -48,28 +47,6 @@ ETC (the derivation that builds the /etc directory) on startup."
#:stop #$(service-stop service))) #:stop #$(service-stop service)))
services)) services))
;; /etc is a mixture of static and dynamic settings. Here is where we
;; initialize it from the static part.
(format #t "populating /etc from ~a...~%" #$etc)
(let ((rm-f (lambda (f)
(false-if-exception (delete-file f)))))
(rm-f "/etc/static")
(symlink #$etc "/etc/static")
(for-each (lambda (file)
;; TODO: Handle 'shadow' specially so that changed
;; password aren't lost.
(let ((target (string-append "/etc/" file))
(source (string-append "/etc/static/" file)))
(rm-f target)
(symlink source target)))
(scandir #$etc
(lambda (file)
(not (member file '("." ".."))))))
;; Prevent ETC from being GC'd.
(rm-f "/var/guix/gcroots/etc-directory")
(symlink #$etc "/var/guix/gcroots/etc-directory"))
;; guix-daemon 0.6 aborts if 'PATH' is undefined, so work around it. ;; guix-daemon 0.6 aborts if 'PATH' is undefined, so work around it.
(setenv "PATH" "/run/current-system/bin") (setenv "PATH" "/run/current-system/bin")

View File

@ -256,10 +256,25 @@ we're running in the final root."
(mlet* %store-monad (mlet* %store-monad
((services (sequence %store-monad (operating-system-services os))) ((services (sequence %store-monad (operating-system-services os)))
(etc (operating-system-etc-directory os)) (etc (operating-system-etc-directory os))
(dmd-conf (dmd-configuration-file services etc))) (modules (imported-modules '((guix build activation))))
(compiled (compiled-modules '((guix build activation))))
(dmd-conf (dmd-configuration-file services)))
(gexp->file "boot" (gexp->file "boot"
#~(execl (string-append #$dmd "/bin/dmd") #~(begin
"dmd" "--config" #$dmd-conf)))) (eval-when (expand load eval)
;; Make sure 'use-modules' below succeeds.
(set! %load-path (cons #$modules %load-path))
(set! %load-compiled-path
(cons #$compiled %load-compiled-path)))
(use-modules (guix build activation))
;; Populate /etc.
(activate-etc #$etc)
;; Start dmd.
(execl (string-append #$dmd "/bin/dmd")
"dmd" "--config" #$dmd-conf)))))
(define (operating-system-derivation os) (define (operating-system-derivation os)
"Return a derivation that builds OS." "Return a derivation that builds OS."

63
guix/build/activation.scm Normal file
View File

@ -0,0 +1,63 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix build activation)
#:use-module (ice-9 ftw)
#:export (activate-etc))
;;; Commentary:
;;;
;;; This module provides "activation" helpers. Activation is the process that
;;; consists in setting up system-wide files and directories so that an
;;; 'operating-system' configuration becomes active.
;;;
;;; Code:
(define (activate-etc etc)
"Install ETC, a directory in the store, as the source of static files for
/etc."
;; /etc is a mixture of static and dynamic settings. Here is where we
;; initialize it from the static part.
(format #t "populating /etc from ~a...~%" etc)
(let ((rm-f (lambda (f)
(false-if-exception (delete-file f)))))
(rm-f "/etc/static")
(symlink etc "/etc/static")
(for-each (lambda (file)
;; TODO: Handle 'shadow' specially so that changed
;; password aren't lost.
(let ((target (string-append "/etc/" file))
(source (string-append "/etc/static/" file)))
(rm-f target)
(symlink source target)))
(scandir etc
(lambda (file)
(not (member file '("." ".."))))
;; The default is 'string-locale<?', but we don't have
;; it when run from the initrd's statically-linked
;; Guile.
string<?))
;; Prevent ETC from being GC'd.
(rm-f "/var/guix/gcroots/etc-directory")
(symlink etc "/var/guix/gcroots/etc-directory")))
;;; activation.scm ends here