system: Install /var/guix/profiles/system-1-link on new systems.

* guix/build/install.scm (directives): Add /var/guix/profiles/system.
  (populate-root-file-system): Add 'system' parameter.  Create
  /var/guix/profiles/system-1-link.
* guix/scripts/system.scm (install): Pass OS-DIR to
  'populate-root-file-system'.
* guix/build/vm.scm (initialize-root-partition): Add #:system-directory
  parameter, and pass it to 'populate-root-file-system'.
  (initialize-hard-disk): Add #:system-directory parameter, and pass it
  to 'initialize-root-partition'.
* gnu/system/vm.scm (qemu-image): Add #:os-derivation parameter and pass
  it to 'initialize-hard-disk'.
  (system-disk-image, system-qemu-image,
  system-qemu-image/shared-store): Pass #:os-derivation to 'qemu-image.

2 files changed, 19 insertions, 7 deletions

diff --git a/guix/build/install.scm b/guix/build/install.scm
index 2a76394faa..ae51ebe48c 100644
--- a/guix/build/install.scm
+++ b/guix/build/install.scm
@@ -83,21 +83,30 @@ STORE."
     (directory "/var/empty")                        ; for no-login accounts
     (directory "/var/run")
     (directory "/run")
+    (directory "/var/guix/profiles/per-user/root" 0 0)
+
+    ;; Link to the initial system generation.
+    ("/var/guix/profiles/system" -> "system-1-link")
+
     ("/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)
+(define (populate-root-file-system system target)
   "Make the essential non-store files and directories on TARGET.  This
-includes /etc, /var, /run, /bin/sh, etc."
+includes /etc, /var, /run, /bin/sh, etc., and all the symlinks to SYSTEM."
   (for-each (cut evaluate-populate-directive <> target)
-            (directives (%store-directory))))
+            (directives (%store-directory)))
+
+  ;; Add system generation 1.
+  (symlink system
+           (string-append target "/var/guix/profiles/system-1-link")))
 
 (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 c1deb35664..805ce10bf9 100644
--- a/guix/build/vm.scm
+++ b/guix/build/vm.scm
@@ -172,7 +172,7 @@ volume name."
 
 (define* (initialize-root-partition target-directory
                                     #:key copy-closures? register-closures?
-                                    closures)
+                                    closures system-directory)
   "Initialize the root partition mounted at TARGET-DIRECTORY."
   (define target-store
     (string-append target-directory (%store-directory)))
@@ -203,10 +203,11 @@ volume name."
 
   ;; Add the non-store directories and files.
   (display "populating...\n")
-  (populate-root-file-system target-directory))
+  (populate-root-file-system system-directory target-directory))
 
 (define* (initialize-hard-disk device
                                #:key
+                               system-directory
                                grub.cfg
                                disk-image-size
                                (file-system-type "ext4")
@@ -218,7 +219,8 @@ volume name."
 partition with (optionally) FILE-SYSTEM-LABEL as its volume name, and with
 GRUB installed.  If REGISTER-CLOSURES? is true, register all of CLOSURES is
 the partition's store.  If COPY-CLOSURES? is true, copy all of CLOSURES to the
-partition."
+partition.  SYSTEM-DIRECTORY is the name of the directory of the 'system'
+derivation."
   (define target-directory
     "/fs")
 
@@ -236,6 +238,7 @@ partition."
   (mount partition target-directory file-system-type)
 
   (initialize-root-partition target-directory
+                             #:system-directory system-directory
                              #:copy-closures? copy-closures?
                              #:register-closures? register-closures?
                              #:closures closures)