diff options
Diffstat (limited to 'gnu/system/install.scm')
| -rw-r--r-- | gnu/system/install.scm | 155 |
1 files changed, 81 insertions, 74 deletions
diff --git a/gnu/system/install.scm b/gnu/system/install.scm index c161526d77..a91c5c3533 100644 --- a/gnu/system/install.scm +++ b/gnu/system/install.scm @@ -24,6 +24,7 @@ #:use-module (guix monads) #:use-module ((guix store) #:select (%store-prefix)) #:use-module (guix profiles) + #:use-module (gnu services dmd) #:use-module (gnu packages admin) #:use-module (gnu packages bash) #:use-module (gnu packages linux) @@ -102,7 +103,7 @@ under /root/.guix-profile where GUIX is installed." (define (log-to-info) "Return a script that spawns the Info reader on the right section of the manual." - (gexp->script "log-to-info" + (program-file "log-to-info" #~(begin ;; 'gunzip' is needed to decompress the doc. (setenv "PATH" (string-append #$gzip "/bin")) @@ -159,70 +160,74 @@ current store is on a RAM disk." (mount "/.rw-store" #$(%store-prefix) "" MS_MOVE) (rmdir "/.rw-store")))))) +(define cow-store-service-type + (dmd-service-type + (lambda _ + (dmd-service + (requirement '(root-file-system user-processes)) + (provision '(cow-store)) + (documentation + "Make the store copy-on-write, with writes going to \ +the given target.") + + ;; This is meant to be explicitly started by the user. + (auto-start? #f) + + (start #~(case-lambda + ((target) + #$(make-cow-store #~target) + target) + (else + ;; Do nothing, and mark the service as stopped. + #f))) + (stop #~(lambda (target) + ;; Delete the temporary directory, but leave everything + ;; mounted as there may still be processes using it since + ;; 'user-processes' doesn't depend on us. The 'user-unmount' + ;; service will unmount TARGET eventually. + (delete-file-recursively + (string-append target #$%backing-directory)))))))) + (define (cow-store-service) "Return a service that makes the store copy-on-write, such that writes go to the user's target storage device rather than on the RAM disk." ;; See <http://bugs.gnu.org/18061> for the initial report. - (with-monad %store-monad - (return (service - (requirement '(root-file-system user-processes)) - (provision '(cow-store)) - (documentation - "Make the store copy-on-write, with writes going to \ -the given target.") + (service cow-store-service-type 'mooooh!)) + + +(define (/etc/configuration-files _) + "Return a list of tuples representing configuration templates to add to +/etc." + (define (file f) + (local-file (search-path %load-path + (string-append "gnu/system/examples/" f)))) + + (define directory + (computed-file "configuration-templates" + #~(begin + (mkdir #$output) + (for-each (lambda (file target) + (copy-file file + (string-append #$output "/" + target))) + '(#$(file "bare-bones.tmpl") + #$(file "desktop.tmpl")) + '("bare-bones.scm" + "desktop.scm")) + #t) + #:modules '((guix build utils)))) + + `(("configuration" ,directory))) + +(define configuration-template-service-type + (service-type (name 'configuration-template) + (extensions + (list (service-extension etc-service-type + /etc/configuration-files))))) + +(define %configuration-template-service + (service configuration-template-service-type #t)) - ;; This is meant to be explicitly started by the user. - (auto-start? #f) - - (start #~(case-lambda - ((target) - #$(make-cow-store #~target) - target) - (else - ;; Do nothing, and mark the service as stopped. - #f))) - (stop #~(lambda (target) - ;; Delete the temporary directory, but leave everything - ;; mounted as there may still be processes using it - ;; since 'user-processes' doesn't depend on us. The - ;; 'user-unmount' service will unmount TARGET - ;; eventually. - (delete-file-recursively - (string-append target #$%backing-directory)))))))) - -(define (configuration-template-service) - "Return a dummy service whose purpose is to install an operating system -configuration template file in the installation system." - - (define search - (cut search-path %load-path <>)) - (define templates - (map (match-lambda - ((file '-> target) - (list (local-file (search file)) - (string-append "/etc/configuration/" target)))) - '(("gnu/system/examples/bare-bones.tmpl" -> "bare-bones.scm") - ("gnu/system/examples/desktop.tmpl" -> "desktop.scm")))) - - (with-monad %store-monad - (return (service - (requirement '(root-file-system)) - (provision '(os-config-template)) - (documentation - "This dummy service installs an OS configuration template.") - (start #~(const #t)) - (stop #~(const #f)) - (activate - #~(begin - (use-modules (ice-9 match) - (guix build utils)) - - (mkdir-p "/etc/configuration") - (for-each (match-lambda - ((file target) - (unless (file-exists? target) - (copy-file file target)))) - '#$templates))))))) (define %nscd-minimal-caches ;; Minimal in-memory caching policy for nscd. @@ -234,7 +239,7 @@ configuration template file in the installation system." (define (installation-services) "Return the list services for the installation image." - (let ((motd (text-file "motd" " + (let ((motd (plain-file "motd" " Welcome to the installation of the Guix System Distribution! There is NO WARRANTY, to the extent permitted by law. In particular, you may @@ -244,25 +249,27 @@ it is alpha software, so it may BREAK IN UNEXPECTED WAYS. You have been warned. Thanks for being so brave. "))) (define (normal-tty tty) - (mingetty-service tty - #:motd motd - #:auto-login "root" - #:login-pause? #t)) + (mingetty-service (mingetty-configuration (tty tty) + (motd motd) + (auto-login "root") + (login-pause? #t)))) - (list (mingetty-service "tty1" - #:motd motd - #:auto-login "root") + (list (mingetty-service (mingetty-configuration + (tty "tty1") + (motd motd) + (auto-login "root"))) ;; Documentation. The manual is in UTF-8, but ;; 'console-font-service' sets up Unicode support and loads a font ;; with all the useful glyphs like em dash and quotation marks. - (mingetty-service "tty2" - #:motd motd - #:auto-login "guest" - #:login-program (log-to-info)) + (mingetty-service (mingetty-configuration + (tty "tty2") + (motd motd) + (auto-login "guest") + (login-program (log-to-info)))) ;; Documentation add-on. - (configuration-template-service) + %configuration-template-service ;; A bunch of 'root' ttys. (normal-tty "tty3") @@ -276,7 +283,7 @@ You have been warned. Thanks for being so brave. ;; The build daemon. Register the hydra.gnu.org key as trusted. ;; This allows the installation process to use substitutes by ;; default. - (guix-service #:authorize-hydra-key? #t) + (guix-service (guix-configuration (authorize-key? #t))) ;; Start udev so that useful device nodes are available. ;; Use device-mapper rules for cryptsetup & co; enable the CRDA for |