X-Git-Url: https://git.hcoop.net/jackhill/guix/guix.git/blobdiff_plain/64de896a71a9ba3091259834077d54c0146bdab6..7e93817dfb021ab0bf881bacc5e028e2becbc6da:/gnu/system.scm

diff --git a/gnu/system.scm b/gnu/system.scm
index 485896ba0a..abdbb081e6 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -110,12 +110,14 @@
 
             system-linux-image-file-name
             operating-system-with-gc-roots
+            operating-system-with-provenance
 
             boot-parameters
             boot-parameters?
             boot-parameters-label
             boot-parameters-root-device
             boot-parameters-bootloader-name
+            boot-parameters-bootloader-menu-entries
             boot-parameters-store-device
             boot-parameters-store-mount-point
             boot-parameters-kernel
@@ -251,6 +253,8 @@ directly by the user."
   ;; OS's root file system, so it might be a device path like "/dev/sda3".
   (root-device      boot-parameters-root-device)
   (bootloader-name  boot-parameters-bootloader-name)
+  (bootloader-menu-entries                        ;list of <menu-entry>
+   boot-parameters-bootloader-menu-entries)
   (store-device     boot-parameters-store-device)
   (store-mount-point boot-parameters-store-mount-point)
   (kernel           boot-parameters-kernel)
@@ -297,6 +301,11 @@ file system labels."
          ((_ args) args)
          (#f       'grub))) ; for compatibility reasons.
 
+      (bootloader-menu-entries
+       (match (assq 'bootloader-menu-entries rest)
+         ((_ entries) (map sexp->menu-entry entries))
+         (#f          '())))
+
       ;; In the past, we would store the directory name of the kernel instead
       ;; of the absolute file name of its image.  Detect that and correct it.
       (kernel (if (string=? linux (direct-store-path linux))
@@ -439,20 +448,21 @@ from the initrd."
   "Return the list of swap services for OS."
   (map swap-service (operating-system-swap-devices os)))
 
-(define* (system-linux-image-file-name #:optional (system (%current-system)))
+(define* (system-linux-image-file-name)
   "Return the basename of the kernel image file for SYSTEM."
   ;; FIXME: Evaluate the conditional based on the actual current system.
-  (cond
-   ((string-prefix? "arm" (%current-system)) "zImage")
-   ((string-prefix? "mips" (%current-system)) "vmlinuz")
-   ((string-prefix? "aarch64" (%current-system)) "Image")
-   (else "bzImage")))
+  (let ((target (or (%current-target-system) (%current-system))))
+    (cond
+     ((string-prefix? "arm" target) "zImage")
+     ((string-prefix? "mips" target) "vmlinuz")
+     ((string-prefix? "aarch64" target) "Image")
+     (else "bzImage"))))
 
 (define (operating-system-kernel-file os)
   "Return an object representing the absolute file name of the kernel image of
 OS."
   (file-append (operating-system-kernel os)
-               "/" (system-linux-image-file-name os)))
+               "/" (system-linux-image-file-name)))
 
 (define* (operating-system-directory-base-entries os)
   "Return the basic entries of the 'system' directory of OS for use as the
@@ -531,6 +541,15 @@ bookkeeping."
                                     gc-root-service-type roots)
                     (operating-system-user-services os)))))
 
+(define* (operating-system-with-provenance os #:optional config-file)
+  "Return a variant of OS that stores its own provenance information,
+including CONFIG-FILE, if available.  This is achieved by adding an instance
+of PROVENANCE-SERVICE-TYPE to its services."
+  (operating-system
+    (inherit os)
+    (services (cons (service provenance-service-type config-file)
+                    (operating-system-user-services os)))))
+
 
 ;;;
 ;;; /etc.
@@ -821,7 +840,12 @@ use 'plain-file' instead~%")
           (file-append inetutils "/bin/ping6")
           (file-append sudo "/bin/sudo")
           (file-append sudo "/bin/sudoedit")
-          (file-append fuse "/bin/fusermount"))))
+          (file-append fuse "/bin/fusermount")
+
+          ;; To allow mounts with the "user" option, "mount" and "umount" must
+          ;; be setuid-root.
+          (file-append util-linux "/bin/mount")
+          (file-append util-linux "/bin/umount"))))
 
 (define %sudoers-specification
   ;; Default /etc/sudoers contents: 'root' and all members of the 'wheel'
@@ -1009,6 +1033,8 @@ such as '--root' and '--load' to <boot-parameters>."
           (operating-system-user-kernel-arguments os)))
      (initrd initrd)
      (bootloader-name bootloader-name)
+     (bootloader-menu-entries
+      (bootloader-configuration-menu-entries (operating-system-bootloader os)))
      (store-device (ensure-not-/dev (file-system-device store)))
      (store-mount-point (file-system-mount-point store)))))
 
@@ -1050,6 +1076,11 @@ being stored into the \"parameters\" file)."
                      #$(boot-parameters-kernel-arguments params))
                     (initrd #$(boot-parameters-initrd params))
                     (bootloader-name #$(boot-parameters-bootloader-name params))
+                    (bootloader-menu-entries
+                     #$(map menu-entry->sexp
+                            (or (and=> (operating-system-bootloader os)
+                                       bootloader-configuration-menu-entries)
+                                '())))
                     (store
                      (device
                       #$(device->sexp (boot-parameters-store-device params)))