From b4140694aca6a717ec130e3788b9d877d1b1e534 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 17 May 2014 17:39:30 +0200 Subject: system: Make /run/current-system at activation time. * gnu/system.scm (etc-directory): Change default value of #:profile. Change contents of SHELLS. Use /run/current-system/profile/{s,}bin in BASHRC. (operating-system-boot-script)[%modules]: Add (guix build linux-initrd). Add call to 'activate-current-system' in gexp. (operating-system-initrd-file, operating-system-grub.cfg): New procedures. (operating-system-derivation): Don't build grub.cfg here and remove it from the file union. * gnu/system/vm.scm (qemu-image): Remove #:populate. (operating-system-build-gid, operating-system-default-contents): Remove. (system-qemu-image): Remove call to 'operating-system-default-contents'. Use 'operating-system-grub.cfg' to get grub.cfg. Add GRUB.CFG to #:inputs. (system-qemu-image/shared-store): Likewise, but don't add GRUB.CFG to #:inputs. (system-qemu-image/shared-store-script): Pass --system kernel option. * guix/build/activation.scm (%booted-system, %current-system): New variables. (boot-time-system, activate-current-system): New procedures. * guix/build/install.scm (evaluate-populate-directive): Add case for ('directory name uid gid mode). (directives, populate-root-file-system): New procedures. * guix/build/vm.scm (initialize-hard-disk): Replace calls to 'evaluate-populate-directive' by a call to 'populate-root-file-system'. * gnu/services/dmd.scm (dmd-configuration-file): Use /run/current-system/profile/bin. * gnu/services/xorg.scm (slim-service): Likewise. --- gnu/services/dmd.scm | 2 +- gnu/services/xorg.scm | 2 +- gnu/system.scm | 56 +++++++++++++++++++++++++++++++----------------- gnu/system/vm.scm | 59 ++++++--------------------------------------------- 4 files changed, 45 insertions(+), 74 deletions(-) (limited to 'gnu') diff --git a/gnu/services/dmd.scm b/gnu/services/dmd.scm index 0d17285890..982c196fe4 100644 --- a/gnu/services/dmd.scm +++ b/gnu/services/dmd.scm @@ -64,7 +64,7 @@ (define config services)) ;; guix-daemon 0.6 aborts if 'PATH' is undefined, so work around it. - (setenv "PATH" "/run/current-system/bin") + (setenv "PATH" "/run/current-system/profile/bin") (format #t "starting services...~%") (for-each start '#$(append-map service-provision services)))) diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm index 1988cfa6a0..7215297f69 100644 --- a/gnu/services/xorg.scm +++ b/gnu/services/xorg.scm @@ -139,7 +139,7 @@ (define (slim.cfg) (mlet %store-monad ((startx (or startx (xorg-start-command))) (xinitrc (xinitrc))) (text-file* "slim.cfg" " -default_path /run/current-system/bin +default_path /run/current-system/profile/bin default_xserver " startx " xserver_arguments :0 vt7 xauth_path " xauth "/bin/xauth diff --git a/gnu/system.scm b/gnu/system.scm index 9ce94d0230..ec3e2fcd6c 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -55,6 +55,7 @@ (define-module (gnu system) operating-system-derivation operating-system-profile + operating-system-grub.cfg file-system @@ -263,7 +264,7 @@ (define* (etc-directory #:key (locale "C") (timezone "Europe/Paris") (skeletons '()) (pam-services '()) - (profile "/var/run/current-system/profile") + (profile "/run/current-system/profile") (sudoers "")) "Return a derivation that builds the static part of the /etc directory." (mlet* %store-monad @@ -273,8 +274,8 @@ (define* (etc-directory #:key (shells (text-file "shells" ; used by xterm and others "\ /bin/sh -/run/current-system/bin/sh -/run/current-system/bin/bash\n")) +/run/current-system/profile/bin/sh +/run/current-system/profile/bin/bash\n")) (issue (text-file "issue" " This is an alpha preview of the GNU system. Welcome. @@ -293,8 +294,8 @@ (define* (etc-directory #:key export TZ=\"" timezone "\" export TZDIR=\"" tzdata "/share/zoneinfo\" -export PATH=$HOME/.guix-profile/bin:" profile "/bin:" profile "/sbin -export PATH=/run/setuid-programs:$PATH +export PATH=/run/setuid-programs:/run/current-system/profile/sbin +export PATH=$HOME/.guix-profile/bin:/run/current-system/profile/bin:$PATH export CPATH=$HOME/.guix-profile/include:" profile "/include export LIBRARY_PATH=$HOME/.guix-profile/lib:" profile "/lib alias ls='ls -p --color' @@ -402,7 +403,8 @@ (define (operating-system-boot-script os) we're running in the final root." (define %modules '((guix build activation) - (guix build utils))) + (guix build utils) + (guix build linux-initrd))) (mlet* %store-monad ((services (operating-system-services os)) (etc (operating-system-etc-directory os)) @@ -446,6 +448,9 @@ (define group-specs ;; Activate setuid programs. (activate-setuid-programs (list #$@setuid-progs)) + ;; Set up /run/current-system. + (activate-current-system #:boot? #t) + ;; Close any remaining open file descriptors to be on the ;; safe side. This must be the very last thing we do, ;; because Guile has internal FDs such as 'sleep_pipe' @@ -466,8 +471,8 @@ (define (operating-system-root-file-system os) (_ #f)) (operating-system-file-systems os))) -(define (operating-system-derivation os) - "Return a derivation that builds OS." +(define (operating-system-initrd-file os) + "Return a gexp denoting the initrd file of OS." (define boot-file-systems (filter (match-lambda (($ device "/") @@ -476,15 +481,16 @@ (define boot-file-systems boot?)) (operating-system-file-systems os))) + (mlet %store-monad + ((initrd ((operating-system-initrd os) boot-file-systems))) + (return #~(string-append #$initrd "/initrd")))) + +(define (operating-system-grub.cfg os) + "Return the GRUB configuration file for OS." (mlet* %store-monad - ((profile (operating-system-profile os)) - (etc (operating-system-etc-directory os)) - (services (operating-system-services os)) - (boot (operating-system-boot-script os)) - (kernel -> (operating-system-kernel os)) - (initrd ((operating-system-initrd os) boot-file-systems)) - (initrd-file -> #~(string-append #$initrd "/initrd")) + ((system (operating-system-derivation os)) (root-fs -> (operating-system-root-file-system os)) + (kernel -> (operating-system-kernel os)) (entries -> (list (menu-entry (label (string-append "GNU system with " @@ -494,15 +500,25 @@ (define boot-file-systems (linux-arguments (list (string-append "--root=" (file-system-device root-fs)) - #~(string-append "--load=" #$boot))) - (initrd initrd-file)))) - (grub.cfg (grub-configuration-file entries))) + #~(string-append "--system=" #$system) + #~(string-append "--load=" #$system + "/boot"))) + (initrd #~(string-append #$system "/initrd")))))) + (grub-configuration-file entries))) + +(define (operating-system-derivation os) + "Return a derivation that builds OS." + (mlet* %store-monad + ((profile (operating-system-profile os)) + (etc (operating-system-etc-directory os)) + (boot (operating-system-boot-script os)) + (kernel -> (operating-system-kernel os)) + (initrd (operating-system-initrd-file os))) (file-union "system" `(("boot" ,#~#$boot) ("kernel" ,#~#$kernel) - ("initrd" ,initrd-file) + ("initrd" ,initrd) ("profile" ,#~#$profile) - ("grub.cfg" ,#~#$grub.cfg) ("etc" ,#~#$etc))))) ;;; system.scm ends here diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 58e5416b3e..4bf0e06081 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -192,7 +192,6 @@ (define* (qemu-image #:key (file-system-type "ext4") grub-configuration (register-closures? #t) - (populate #f) (inputs '()) copy-inputs?) "Return a bootable, stand-alone QEMU image, with a root partition of type @@ -203,12 +202,7 @@ (define* (qemu-image #:key INPUTS is a list of inputs (as for packages). When COPY-INPUTS? is true, copy all of INPUTS into the image being built. When REGISTER-CLOSURES? is true, register INPUTS in the store database of the image so that Guix can be used in -the image. - -POPULATE is a list of directives stating directories or symlinks to be created -in the disk image partition. It is evaluated once the image has been -populated with INPUTS-TO-COPY. It can be used to provide additional files, -such as /etc files." +the image." (mlet %store-monad ((graph (sequence %store-monad (map input->name+output inputs)))) (expression->derivation-in-linux-vm @@ -241,8 +235,7 @@ (define* (qemu-image #:key #:copy-closures? #$copy-inputs? #:register-closures? #$register-closures? #:disk-image-size #$disk-image-size - #:file-system-type #$file-system-type - #:directives '#$populate) + #:file-system-type #$file-system-type) (reboot)))) #:system system #:make-disk-image? #t @@ -254,39 +247,6 @@ (define* (qemu-image #:key ;;; Stand-alone VM image. ;;; -(define (operating-system-build-gid os) - "Return as a monadic value the group id for build users of OS, or #f." - (mlet %store-monad ((services (operating-system-services os))) - (return (any (lambda (service) - (and (equal? '(guix-daemon) - (service-provision service)) - (match (service-user-groups service) - ((group) - (user-group-id group))))) - services)))) - -(define (operating-system-default-contents os) - "Return a list of directives suitable for 'system-qemu-image' describing the -basic contents of the root file system of OS." - (mlet* %store-monad ((os-drv (operating-system-derivation os)) - (build-gid (operating-system-build-gid os)) - (profile (operating-system-profile os))) - (return #~((directory #$(%store-prefix) 0 #$(or build-gid 0)) - (directory "/etc") - (directory "/var/log") ; for dmd - (directory "/var/run/nscd") - (directory "/var/guix/gcroots") - ("/var/guix/gcroots/system" -> #$os-drv) - (directory "/run") - ("/run/current-system" -> #$profile) - (directory "/bin") - ("/bin/sh" -> "/run/current-system/bin/bash") - (directory "/tmp") - (directory "/var/guix/profiles/per-user/root" 0 0) - - (directory "/root" 0 0) ; an exception - (directory "/home" 0 0))))) - (define* (system-qemu-image os #:key (file-system-type "ext4") @@ -312,14 +272,12 @@ (define file-systems-to-keep file-systems-to-keep))))) (mlet* %store-monad ((os-drv (operating-system-derivation os)) - (os-dir -> (derivation->output-path os-drv)) - (grub.cfg -> (string-append os-dir "/grub.cfg")) - (populate (operating-system-default-contents os))) + (grub.cfg (operating-system-grub.cfg os))) (qemu-image #:grub-configuration grub.cfg - #:populate populate #:disk-image-size disk-image-size #:file-system-type file-system-type - #:inputs `(("system" ,os-drv)) + #:inputs `(("system" ,os-drv) + ("grub.cfg" ,grub.cfg)) #:copy-inputs? #t)))) (define (virtualized-operating-system os) @@ -356,11 +314,8 @@ (define* (system-qemu-image/shared-store with the host." (mlet* %store-monad ((os-drv (operating-system-derivation os)) - (os-dir -> (derivation->output-path os-drv)) - (grub.cfg -> (string-append os-dir "/grub.cfg")) - (populate (operating-system-default-contents os))) + (grub.cfg (operating-system-grub.cfg os))) (qemu-image #:grub-configuration grub.cfg - #:populate populate #:disk-image-size disk-image-size #:inputs `(("system" ,os-drv)) @@ -390,7 +345,7 @@ (define builder -kernel " #$(operating-system-kernel os) "/bzImage \ -initrd " #$os-drv "/initrd \ -append \"" #$(if graphic? "" "console=ttyS0 ") - "--load=" #$os-drv "/boot --root=/dev/vda1\" \ + "--system=" #$os-drv " --load=" #$os-drv "/boot --root=/dev/vda1\" \ -serial stdio \ -drive file=" #$image ",if=virtio,cache=writeback,werror=report,readonly\n") -- cgit v1.2.3