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.

1 files changed, 7 insertions, 52 deletions

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 @@ made available under the /xchg CIFS share."
                      (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 @@ file (GRUB-CONFIGURATION must be the name of a file in the VM.)
 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 @@ such as /etc files."
                                   #: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 @@ such as /etc files."
 ;;; 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 @@ of the GNU system as described by OS."
                                   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 @@ environment with the store shared with the host."
 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 @@ exec " #$qemu "/bin/qemu-system-x86_64 -enable-kvm -no-reboot -net nic,model=vir
   -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")