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.

3 files changed, 73 insertions, 13 deletions

diff --git a/guix/build/activation.scm b/guix/build/activation.scm
index 267c592b52..49f98c021d 100644
--- a/guix/build/activation.scm
+++ b/guix/build/activation.scm
@@ -18,13 +18,15 @@
 
 (define-module (guix build activation)
   #:use-module (guix build utils)
+  #:use-module (guix build linux-initrd)
   #:use-module (ice-9 ftw)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:export (activate-users+groups
             activate-etc
-            activate-setuid-programs))
+            activate-setuid-programs
+            activate-current-system))
 
 ;;; Commentary:
 ;;;
@@ -195,4 +197,33 @@ numeric gid or #f."
 
   (for-each make-setuid-program programs))
 
+(define %booted-system
+  ;; The system we booted in (a symlink.)
+  "/run/booted-system")
+
+(define %current-system
+  ;; The system that is current (a symlink.)  This is not necessarily the same
+  ;; as %BOOTED-SYSTEM, for instance because we can re-build a new system
+  ;; configuration and activate it, without rebooting.
+  "/run/current-system")
+
+(define (boot-time-system)
+  "Return the '--system' argument passed on the kernel command line."
+  (find-long-option "--system" (linux-command-line)))
+
+(define* (activate-current-system #:optional (system (boot-time-system))
+                                  #:key boot?)
+  "Atomically make SYSTEM the current system.  When BOOT? is true, also make
+it the booted system."
+  (format #t "making '~a' the current system...~%" system)
+  (when boot?
+    (when (file-exists? %booted-system)
+      (delete-file %booted-system))
+    (symlink system %booted-system))
+
+  ;; Atomically make SYSTEM current.
+  (let ((new (string-append %current-system ".new")))
+    (symlink system new)
+    (rename-file new %current-system)))
+
 ;;; activation.scm ends here
diff --git a/guix/build/install.scm b/guix/build/install.scm
index 37153703e5..a0be6e9d39 100644
--- a/guix/build/install.scm
+++ b/guix/build/install.scm
@@ -19,9 +19,10 @@
 (define-module (guix build install)
   #:use-module (guix build utils)
   #:use-module (guix build install)
+  #:use-module (srfi srfi-26)
   #:use-module (ice-9 match)
   #:export (install-grub
-            evaluate-populate-directive
+            populate-root-file-system
             reset-timestamps
             register-closure))
 
@@ -46,15 +47,44 @@ MOUNT-POINT.  Return #t on success."
 (define (evaluate-populate-directive directive target)
   "Evaluate DIRECTIVE, an sexp describing a file or directory to create under
 directory TARGET."
-  (match directive
-    (('directory name)
-     (mkdir-p (string-append target name)))
-    (('directory name uid gid)
-     (let ((dir (string-append target name)))
-       (mkdir-p dir)
-       (chown dir uid gid)))
-    ((new '-> old)
-     (symlink old (string-append target new)))))
+  (let loop ((directive directive))
+    (match directive
+      (('directory name)
+       (mkdir-p (string-append target name)))
+      (('directory name uid gid)
+       (let ((dir (string-append target name)))
+         (mkdir-p dir)
+         (chown dir uid gid)))
+      (('directory name uid gid mode)
+       (loop `(directory ,name ,uid ,gid))
+       (chmod (string-append target name) mode))
+      ((new '-> old)
+       (symlink old (string-append target new))))))
+
+(define (directives store)
+  "Return a list of directives to populate the root file system that will host
+STORE."
+  `((directory ,store 0 0)
+    (directory "/etc")
+    (directory "/var/log")                          ; for dmd
+    (directory "/var/run/nscd")
+    (directory "/var/guix/gcroots")
+    (directory "/run")
+    ("/var/guix/gcroots/booted-system" -> "/run/booted-system")
+    ("/var/guix/gcroots/current-system" -> "/run/current-system")
+    (directory "/bin")
+    ("/bin/sh" -> "/run/current-system/profile/bin/bash")
+    (directory "/tmp" 0 0 #o1777)                 ; sticky bit
+    (directory "/var/guix/profiles/per-user/root" 0 0)
+
+    (directory "/root" 0 0)                       ; an exception
+    (directory "/home" 0 0)))
+
+(define (populate-root-file-system target)
+  "Make the essential non-store files and directories on TARGET.  This
+includes /etc, /var, /run, /bin/sh, etc."
+  (for-each (cut evaluate-populate-directive <> target)
+            (directives (%store-directory))))
 
 (define (reset-timestamps directory)
   "Reset the timestamps of all the files under DIRECTORY, so that they appear
diff --git a/guix/build/vm.scm b/guix/build/vm.scm
index 12f952bd11..b9bb66cdb7 100644
--- a/guix/build/vm.scm
+++ b/guix/build/vm.scm
@@ -206,8 +206,7 @@ further populate the partition."
 
   ;; Evaluate the POPULATE directives.
   (display "populating...\n")
-  (for-each (cut evaluate-populate-directive <> target-directory)
-            directives)
+  (populate-root-file-system target-directory)
 
   (unless (install-grub grub.cfg "/dev/sda" target-directory)
     (error "failed to install GRUB"))