wip v2 u-boot support

Message ID 20160905222911.7ee7a4a5@scratchpost.org
State New

Commit Message

Danny Milosavljevic Sept. 5, 2016, 8:29 p.m. UTC
  Whoops, now with the correct u-boot.scm

On Mon, 5 Sep 2016 21:58:03 +0200
Danny Milosavljevic <dannym@scratchpost.org> wrote:

> Hi David,
> I thought I'd post a minimal version for U-Boot support without any renames that aren't absolutely necessary. In this way, the patch is quite small.
> I think I also figured out how to pass the name of the bootloader installation executable - that's also included.
> Let's see whether it works.
> See attachement...
> I assume that gnu/system/u-boot.scm already exists.
> If it doesn't, I've also attached the latest version of it.
> As you can see it's no big deal.
> Note that the only reasons <u-boot-configuration> is distinct from <grub-configuration> are:
> - The field "board" which contains the board name is necessary in <u-boot-configuration> but not <grub-configuration>.
> - The system config's "operating-system" definition contains a "bootloader" field that is actually a bootloader-configuration (rather than the actual bootloader package or similar). Hence there would be no way to find out which bootloader to install if the configuration wasn't a different data structure.
> I'm not sure those are good enough reasons to justify distinguishing them.
> It would also be possible to change the system config to something like
> (operating-system
>   (bootloader grub (bootloader-configuration ...)))
> and
> (operating-system
>   (bootloader (make-u-boot-package "my_great_system") (bootloader-configuration ...)))
> and then drop "board". In that case, <u-boot-configuration> would be the same as <grub-configuration> - but grub-configuration supports theming which u-boot-configuration doesn't. We could just ignore the theme parts in that case, though.


David Craven Sept. 6, 2016, 4:34 p.m. UTC | #1
Hi Danny,

Looks nice! I'll see if I can get guixsd to boot a beaglebone black
I've got lying around, probably this weekend (maybe earlier, I'd like
to finish my work on hawaii and plymouth first). It looks like getting
qemu to boot guixsd on arm is harder than I expected...



diff --git a/gnu.scm b/gnu.scm
index 932e4cd..9207e38 100644
--- a/gnu.scm
+++ b/gnu.scm
@@ -35,6 +35,7 @@ 
         (gnu system mapped-devices)
         (gnu system file-systems)
         (gnu system grub)                         ; 'grub-configuration'
+        (gnu system u-boot)                       ; 'u-boot-configuration'
         (gnu system pam)
         (gnu system shadow)                       ; 'user-account'
         (gnu system linux-initrd)
diff --git a/gnu/build/install.scm b/gnu/build/install.scm
index 7431a09..92740d5 100644
--- a/gnu/build/install.scm
+++ b/gnu/build/install.scm
@@ -21,7 +21,7 @@ 
   #:use-module (guix build store-copy)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 match)
-  #:export (install-grub
+  #:export (install-bootloader
@@ -36,28 +36,49 @@ 
 ;;; Code:
-(define* (install-grub grub.cfg device mount-point)
+(define* (install-bootloader-config source target)
+  (let* ((pivot  (string-append target ".new")))
+    (mkdir-p (dirname target))
+    ;; Copy bootloader config file instead of just symlinking it, because symlinks won't
+    ;; work when /boot is on a separate partition.  Do that atomically.
+    (copy-file source pivot)
+    (rename-file pivot target)))
+(define* (install-grub grub-name grub.cfg device mount-point)
   "Install GRUB with GRUB.CFG on DEVICE, which is assumed to be mounted on
+MOUNT-POINT. FIXME is that correct?
 Note that the caller must make sure that GRUB.CFG is registered as a GC root
 so that the fonts, background images, etc. referred to by GRUB.CFG are not
-  (let* ((target (string-append mount-point "/boot/grub/grub.cfg"))
-         (pivot  (string-append target ".new")))
-    (mkdir-p (dirname target))
-    ;; Copy GRUB.CFG instead of just symlinking it, because symlinks won't
-    ;; work when /boot is on a separate partition.  Do that atomically.
-    (copy-file grub.cfg pivot)
-    (rename-file pivot target)
+  (let ((target (string-append mount-point "/boot/grub/grub.cfg")))
+    (install-bootloader-config grub.cfg target)
     (unless (zero? (system* "grub-install" "--no-floppy"
                             (string-append mount-point "/boot")
       (error "failed to install GRUB"))))
+(define* (install-u-boot u-boot-name extlinux.conf device mount-point)
+  "Install U-Boot with EXTLINUX.CONF on DEVICE, which is assumed to be mounted on
+MOUNT-POINT. FIXME is that correct?"
+    (install-bootloader-config extlinux.conf
+                               (string-append mount-point
+                                              "/extlinux.conf"))
+    (unless (zero? (system* (string-append u-boot-name "/bin/u-boot-install")
+                            (string-append "--boot-directory=" mount-point)
+                            device))
+      (error "failed to install U-Boot")))
+(define* (install-bootloader package-output-name config-filename device mount-point)
+  "Install bootloader with CONFIG-FILENAME on DEVICE, which is assumed to be
+mounted on MOUNT-POINT."
+  (let* ((grub? (string-contains package-output-name "grub"))
+         (bootloader-installer (if grub? install-grub
+                                         install-u-boot)))
+    (bootloader-installer package-output-name config-filename device mount-point)))
 (define (evaluate-populate-directive directive target)
   "Evaluate DIRECTIVE, an sexp describing a file or directory to create under
 directory TARGET."
diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index cc5cf45..2e2079e 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -295,6 +295,7 @@  SYSTEM-DIRECTORY is the name of the directory of the 'system' derivation."
 (define* (initialize-hard-disk device
+                               grub
                                (partitions '()))
   "Initialize DEVICE as a disk containing all the <partition> objects listed
@@ -313,7 +314,7 @@  passing it a directory name where it is mounted."
     (display "mounting root partition...\n")
     (mkdir-p target)
     (mount (partition-device root) target (partition-file-system root))
-    (install-grub grub.cfg device target)
+    (install-bootloader grub grub.cfg device target)
     ;; Register GRUB.CFG as a GC root.
     (register-grub.cfg-root target grub.cfg)
diff --git a/gnu/system.scm b/gnu/system.scm
index 0802010..24e4e15 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -47,6 +47,7 @@ 
   #:use-module (gnu services shepherd)
   #:use-module (gnu services base)
   #:use-module (gnu system grub)
+  #:use-module (gnu system u-boot)
   #:use-module (gnu system shadow)
   #:use-module (gnu system nss)
   #:use-module (gnu system locale)
@@ -89,6 +90,7 @@ 
+            operating-system-grub
@@ -703,6 +705,13 @@  listed in OS.  The C library expects to find it under
   "Return the file system that contains the store of OS."
   (store-file-system (operating-system-file-systems os)))
+(define (operating-system-grub os)
+  (match (operating-system-bootloader os)
+    ((? grub-configuration? config)
+     (grub-configuration-package config))
+    ((? u-boot-configuration? config)
+     (u-boot-configuration-package config))))
 (define* (operating-system-grub.cfg os #:optional (old-entries '()))
   "Return the GRUB configuration file for OS.  Use OLD-ENTRIES to populate the
 \"old entries\" menu."
diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm
index 45b46ca..4c9da8c 100644
--- a/gnu/system/grub.scm
+++ b/gnu/system/grub.scm
@@ -49,6 +49,7 @@ 
+            grub-configuration-package
@@ -141,6 +142,9 @@ 
                          (system* (string-append #$imagemagick "/bin/convert")
                                   "-resize" #$size #$image #$output)))))
+(define (grub-configuration-package config)
+  grub)
 (define* (grub-background-image config #:key (width 1024) (height 768))
   "Return the GRUB background image defined in CONFIG with a ratio of
 WIDTH/HEIGHT, or #f if none was found."
diff --git a/gnu/system/u-boot.scm b/gnu/system/u-boot.scm
index acc529a..00a0165 100644
--- a/gnu/system/u-boot.scm
+++ b/gnu/system/u-boot.scm
@@ -35,7 +35,7 @@ 
   #:export (u-boot-configuration
-            u-boot-configuration-u-boot
+            u-boot-configuration-package
@@ -61,6 +61,10 @@ 
+(define (u-boot-configuration-package config)
+  (or (u-boot-configuration-u-boot config)
+      (make-u-boot-package (u-boot-configuration-board config))))
 ;;; Configuration file.
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 4c53edc..e04d8fc 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -175,6 +175,7 @@  made available under the /xchg CIFS share."
                      (file-system-type "ext4")
+                     grub
                      (register-closures? #t)
                      (inputs '())
@@ -231,6 +232,7 @@  the image."
                                      (initializer initialize)))))
              (initialize-hard-disk "/dev/vda"
                                    #:partitions partitions
+                                   #:grub #$grub
                                    #:grub.cfg #$grub-configuration)
    #:system system
@@ -283,9 +285,11 @@  to USB sticks meant to be read-only."
     (mlet* %store-monad ((os-drv   (operating-system-derivation os))
+                         (grub     (operating-system-grub os))
                          (grub.cfg (operating-system-grub.cfg os)))
       (qemu-image #:name name
                   #:os-derivation os-drv
+                  #:grub grub
                   #:grub-configuration grub.cfg
                   #:disk-image-size disk-image-size
                   #:disk-image-format "raw"
@@ -330,6 +334,7 @@  of the GNU system as described by OS."
         ((os-drv      (operating-system-derivation os))
          (grub.cfg    (operating-system-grub.cfg os)))
       (qemu-image  #:os-derivation os-drv
+                   #:grub grub
                    #:grub-configuration grub.cfg
                    #:disk-image-size disk-image-size
                    #:file-system-type file-system-type
@@ -416,12 +421,14 @@  When FULL-BOOT? is true, return an image that does a complete boot sequence,
 bootloaded included; thus, make a disk image that contains everything the
 bootloader refers to: OS kernel, initrd, bootloader data, etc."
   (mlet* %store-monad ((os-drv   (operating-system-derivation os))
+                       (grub (operating-system-grub os))
                        (grub.cfg (operating-system-grub.cfg os)))
     ;; XXX: When FULL-BOOT? is true, we end up creating an image that contains
     ;; GRUB.CFG and all its dependencies, including the output of OS-DRV.
     ;; This is more than needed (we only need the kernel, initrd, GRUB for its
     ;; font, and the background image), but it's hard to filter that.
     (qemu-image #:os-derivation os-drv
+                #:grub grub
                 #:grub-configuration grub.cfg
                 #:disk-image-size disk-image-size
                 #:inputs (if full-boot?
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 953c624..738fa6b 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -126,7 +126,7 @@  TARGET, and register them."
               (map (cut copy-item <> target #:log-port log-port)
-(define (install-grub* grub.cfg device target)
+(define (install-bootloader* grub grub.cfg device target)
   "This is a variant of 'install-grub' with error handling, lifted in
   (let* ((gc-root      (string-append target %gc-roots-directory
@@ -140,7 +140,7 @@  TARGET, and register them."
       ;; 'install-grub' completes (being a bit paranoid.)
       (make-symlink temp-gc-root grub.cfg)
-      (munless (false-if-exception (install-grub grub.cfg device target))
+      (munless (false-if-exception (install-bootloader grub grub.cfg device target))
         (delete-file temp-gc-root)
         (leave (_ "failed to install GRUB on device '~a'~%") device))
@@ -150,7 +150,7 @@  TARGET, and register them."
 (define* (install os-drv target
                   #:key (log-port (current-output-port))
-                  grub? grub.cfg device)
+                  grub grub? grub.cfg device)
   "Copy the closure of GRUB.CFG, which includes the output of OS-DRV, to
 directory TARGET.  TARGET must be an absolute directory name since that's what
 'guix-register' expects.
@@ -193,7 +193,7 @@  the ownership of '~a' may be incorrect!~%")
       (populate os-dir target)
       (mwhen grub?
-        (install-grub* grub.cfg device target)))))
+        (install-bootloader* grub grub.cfg device target)))))
@@ -598,13 +598,15 @@  building anything."
              (mbegin %store-monad
                (switch-to-system os)
                (mwhen grub?
-                 (install-grub* (derivation->output-path grub.cfg)
-                                device "/"))))
+                 (install-bootloader* (derivation->output-path grub)
+                                      (derivation->output-path grub.cfg)
+                                      device "/"))))
              (format #t (_ "initializing operating system under '~a'...~%")
              (install sys (canonicalize-path target)
+                      #:grub grub
                       #:grub? grub?
                       #:grub.cfg (derivation->output-path grub.cfg)
                       #:device device))