Patchwork [WIP] gnu: add U-Boot support to operating-system configuration.

login
register
mail settings
Submitter Danny Milosavljevic
Date Sept. 9, 2016, 6:09 p.m.
Message ID <20160909180915.2696-1-dannym@scratchpost.org>
Download mbox | patch
Permalink /patch/15469/
State New
Headers show

Comments

Danny Milosavljevic - Sept. 9, 2016, 6:09 p.m.
---
 gnu.scm                 |   1 +
 gnu/build/install.scm   |  45 +++++++++++++-----
 gnu/build/vm.scm        |   3 +-
 gnu/system.scm          |  20 +++++++-
 gnu/system/grub.scm     |   5 ++
 gnu/system/u-boot.scm   | 124 ++++++++++++++++++++++++++++++++++++++++++++++++
 gnu/system/vm.scm       |   7 +++
 guix/scripts/system.scm |  14 +++---
 8 files changed, 199 insertions(+), 20 deletions(-)
 create mode 100644 gnu/system/u-boot.scm
David Craven - Sept. 10, 2016, 5:52 p.m.
Thanks Danny! Awesome work! =) I'm really excited to see this hitting master...
Danny Milosavljevic - Sept. 16, 2016, 11:07 a.m.
Hi everyone,

On Sat, 10 Sep 2016 19:52:49 +0200
David Craven <david@craven.ch> wrote:
> Thanks Danny! Awesome work! =) I'm really excited to see this hitting master...

Thanks.

The version I posted in this thread should be the simplest version that still works.

I'm using the grub part of it every day (I modified my original git guix and did system reconfigure multiple times) so I've tested it. 

Did you test the vm part? I ran it and I can see that it starts up and provides ssh, apparently, but I have no idea how to connect to its network. 

If all these things are fine I think it would be ready enough to merge.

There is still future work to be done (renaming "grub" -> "bootloader" etc except for the really grub-specific parts) but it's actually not that important to rename - it works now.

Also there are still open questions:

- How did install-grub find grub before? I do pass where the grub-install executable is as parameter now and that works. But how did it work without it? *scratches head* (there was a thread "How does install-grub work?" before but apparently nobody knows)

- It would be nice to have a (bootloader (grub-configuration (package grub)))  which would install grub if "package" was specified and not install grub otherwise (but do install the config files). Likewise for (bootloader (u-boot-configuration (package (make-u-boot-package ....)))). Right now - as David found out - the package "grub" is hardcoded in some places instead. Do we want that?

- Do we want to install both config files (the one for grub and the one for u-boot (and possible other)) automatically every time the system is reconfigured? That would require less configuration - it would just magically work if there is any of these bootloaders installed already (without any "(bootloader ...)" form). Right now you have to choose between u-boot-configuration and grub-configuration - but actually that choice could be dispensed with if we wanted - there's very little - if any - difference in what config data they need (the *format* is different). 

- I added a FIXME to the install-grub documentation comment because I don't think that's the entire story.

  It says "Install GRUB with GRUB.CFG on DEVICE, which is assumed to be mounted on MOUNT-POINT.". Does it mean "Install GRUB (with GRUB.CFG on DEVICE), which is assumed to be mounted on MOUNT-POINT" or "Install (GRUB with GRUB.CFG) on DEVICE, which is assumed to be mounted on MOUNT-POINT"?

  Usually I install grub to a drive, not a specific partition. My bootloader form says (grub-configuration (device "/dev/sda")) and that seems to work fine.

  But the GRUB.CFG is on a partition. Which one? It seems certainly able to find out where - and it all works fine. So if someone knows how that works, exactly, please clarify the comment :)

  It's a similar situation with U-Boot - only I don't think that it's permissible to install u-boot onto a partition at all. Its config file yes. Its executable? No.
Vincent Legoll - Sept. 16, 2016, 12:26 p.m.
Hello,

The following hopefully is not too far from the truth, memory is somewhat
fading away...

> It says "Install GRUB with GRUB.CFG on DEVICE, which is assumed
> to be mounted on MOUNT-POINT."
> Does it mean "Install GRUB (with GRUB.CFG on DEVICE), which is
> assumed to be mounted on MOUNT-POINT"
> or "Install (GRUB with GRUB.CFG) on DEVICE, which is assumed to
> be mounted on MOUNT-POINT"?

I'm not sure I understand your question, but I guess it would be  the second
one.

> Usually I install grub to a drive, not a specific partition. My bootloader form
> says (grub-configuration (device "/dev/sda")) and that seems to work fine.

Yep, grub is installed as a MBR (Master Boot Record, first 512 bytes of the
drive)

> But the GRUB.CFG is on a partition. Which one?

The one holding (typically) /boot (which often is a separate
partition, or / if not),
but that is only default values, /path/to/grub.cfg can be specified by CLI args.

> It seems certainly able to find out where - and it all works fine.
> So if someone knows how that works, exactly, please clarify the comment :)

Grub knows filesystems, and has find functionality, unlike its
predecessor "lilo",
which at update time registered the disk block numbers to read at boot time, it
was fragile, and you better remember to update it when you changed anything
boot-related.

> It's a similar situation with U-Boot - only I don't think that it's permissible to
>install u-boot onto a partition at all. Its config file yes. Its executable? No.

I'm new to uboot, so can't help with that one.

Hope it helps.
David Craven - Sept. 17, 2016, 7:47 a.m.
> Did you test the vm part? I ran it and I can see that it starts up and provides ssh, apparently, but I have no idea how to connect to its network.

Works well. The only part I removed was the install-u-boot part so
that it only installs the extlinux.conf. I think this is close to what
we want and can be merged at some point. (Probably after the next
release, I think people are working on getting core-updates merged at
the moment)

I haven't been able to thoroughly test it yet, since my beagle bone is
too underpowered to compile a linux-kernel for itself. It fails with
failed to allocate memory when creating the compressed kernel image.
I'm hoping that there is a substitute available soon, but I can't tell
from looking at the gnu.hydra.org web interface...
David Craven - Sept. 17, 2016, 5:08 p.m.
Hi Danny,

Tested u-boot-beagle-bone-black, it boots arch linux arm after making
some modifications.

I managed to build the system natively and install it using guix
system init. This required a few modifications here and there. There's
a boot problem obviously - would be to easy if not. I ordered a ftdi
breakout cable, so that I can get some serial output, so I'll probably
be able to continue next weekend.

David
Ludovic Courtès - Sept. 24, 2016, 4:16 a.m.
Hi,

David Craven <david@craven.ch> skribis:

> Tested u-boot-beagle-bone-black, it boots arch linux arm after making
> some modifications.

Good progress already!

> I managed to build the system natively and install it using guix
> system init. This required a few modifications here and there. There's
> a boot problem obviously - would be to easy if not. I ordered a ftdi
> breakout cable, so that I can get some serial output, so I'll probably
> be able to continue next weekend.

Heh, reminds me of hacks with a plug computer a few years back.

Thanks for getting this going, gentlefolks!

Ludo’.

Patch

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
             populate-root-file-system
             reset-timestamps
             register-closure
@@ -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.
+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
 GC'd."
-  (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"
                             "--boot-directory"
                             (string-append mount-point "/boot")
                             device))
       (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
                                #:key
+                               grub
                                grub.cfg
                                (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..0c54f8f 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-derivation
             operating-system-profile
+            operating-system-grub
             operating-system-grub.cfg
             operating-system-etc-directory
             operating-system-locale-directory
@@ -703,6 +705,22 @@  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 os))
+    ((? u-boot-configuration? config)
+     (u-boot-configuration-package config os))))
+
+(define* (bootloader-configuration-file config store-fs entries
+                                        #:key
+                                        (system (%current-system))
+                                        (old-entries '()))
+  ((match config
+    ((? grub-configuration? config) grub-configuration-file)
+    ((? u-boot-configuration? config) u-boot-configuration-file))
+    config store-fs entries #:system system #:old-entries old-entries))
+
 (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."
@@ -724,7 +742,7 @@  listed in OS.  The C library expects to find it under
                                                     "/boot")
                                    (operating-system-kernel-arguments os)))
                            (initrd #~(string-append #$system "/initrd"))))))
-    (grub-configuration-file (operating-system-bootloader os)
+    (bootloader-configuration-file (operating-system-bootloader os)
                              store-fs entries
                              #:old-entries old-entries)))
 
diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm
index aa93c0f..923055e 100644
--- a/gnu/system/grub.scm
+++ b/gnu/system/grub.scm
@@ -49,8 +49,10 @@ 
 
             grub-configuration
             grub-configuration?
+            grub-configuration-package
             grub-configuration-device
 
+            <menu-entry>
             menu-entry
             menu-entry?
 
@@ -141,6 +143,9 @@ 
                          (system* (string-append #$imagemagick "/bin/convert")
                                   "-resize" #$size #$image #$output)))))
 
+(define (grub-configuration-package config os)
+  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
new file mode 100644
index 0000000..290772f
--- /dev/null
+++ b/gnu/system/u-boot.scm
@@ -0,0 +1,124 @@ 
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016 Danny Milosavljevic <dannym+a@scratchpost.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu system u-boot)
+  #:use-module (guix store)
+  #:use-module (guix packages)
+  #:use-module (guix derivations)
+  #:use-module (guix records)
+  #:use-module (guix monads)
+  #:use-module (guix gexp)
+  #:use-module (guix download)
+  #:use-module (gnu artwork)
+  #:use-module (gnu system file-systems)
+  #:autoload   (gnu packages u-boot) (make-u-boot-package)
+  #:use-module (gnu system grub) ; <menu-entry>
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 regex)
+  #:use-module (srfi srfi-1)
+  #:export (u-boot-configuration
+            u-boot-configuration?
+            u-boot-configuration-package
+            u-boot-configuration-device
+            u-boot-configuration-file))
+
+;;; Commentary:
+;;;
+;;; Configuration of U-Boot.
+;;;
+;;; Code:
+
+(define-record-type* <u-boot-configuration>
+  u-boot-configuration make-u-boot-configuration
+  u-boot-configuration?
+  (board           u-boot-board (default #f)) ; string
+  (u-boot          u-boot-configuration-u-boot           ; package
+                   (default #f)) ; will actually default to (make-u-boot-package board)
+  (device          u-boot-configuration-device (default #f))        ; string
+  (menu-entries    u-boot-configuration-menu-entries   ; list
+                   (default '()))
+  (default-entry   u-boot-configuration-default-entry  ; integer
+                   (default 0))
+  (timeout         u-boot-configuration-timeout        ; integer
+                   (default 5)))
+
+
+
+(define (u-boot-configuration-package config os)
+  (or (u-boot-configuration-u-boot config)
+      (make-u-boot-package (u-boot-configuration-board os))))
+
+;;;
+;;; Configuration file.
+;;;
+
+(define* (u-boot-configuration-file config store-fs entries
+                                  #:key
+                                  (system (%current-system))
+                                  (old-entries '()))
+  "Return the U-Boot configuration file corresponding to CONFIG, a
+<u-boot-configuration> object, and where the store is available at STORE-FS, a
+<file-system> object.  OLD-ENTRIES is taken to be a list of menu entries
+corresponding to old generations of the system."
+  (define linux-image-name
+    (if (string-prefix? "mips" system)
+        "vmlinuz"
+        "bzImage"))
+
+  (define all-entries
+    (append entries (u-boot-configuration-menu-entries config)))
+
+  (define entry->gexp
+    (match-lambda
+     (($ <menu-entry> label linux arguments initrd)
+      ;; TODO MENU LABEL hotkeys (using caret)
+      #~(format port "LABEL ~s
+  MENU LABEL ~a
+  KERNEL ~a/~a
+  INITRD ~a
+  FDTDIR .
+  APPEND ~a
+~%"
+                #$label #$label
+                #$linux #$linux-image-name
+                #$initrd
+                (string-join (list #$@arguments))))))
+
+  (define builder
+      #~(call-with-output-file #$output
+          (lambda (port)
+            (let ((timeout #$(u-boot-configuration-timeout config)))
+              (format port "
+DEFAULT ~a
+PROMPT ~a
+TIMEOUT ~a~%"
+                      #$(u-boot-configuration-default-entry config)
+                      (if (< timeout 0) 1 0)
+                      (* 10 timeout))
+            #$@(map entry->gexp all-entries)
+
+            #$@(if (pair? old-entries)
+                   #~((format port "~%")
+                      #$@(map entry->gexp old-entries)
+                      (format port "~%"))
+                   #~())))))
+
+    (gexp->derivation "extlinux.conf" builder))
+
+;;; u-boot.scm ends here
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 03f7d6c..25f186f 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")
                      file-system-label
                      os-derivation
+                     grub
                      grub-configuration
                      (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)
              (reboot)))))
    #:system system
@@ -283,9 +285,11 @@  to USB sticks meant to be read-only."
                                   file-systems-to-keep)))))
 
     (mlet* %store-monad ((os-drv   (operating-system-derivation os))
+                         (grub     (package->derivation (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 (package->derivation (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)
                    to-copy))))
 
-(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
 %STORE-MONAD"
   (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 "/"))))
             ((init)
              (newline)
              (format #t (_ "initializing operating system under '~a'...~%")
                      target)
              (install sys (canonicalize-path target)
+                      #:grub grub
                       #:grub? grub?
                       #:grub.cfg (derivation->output-path grub.cfg)
                       #:device device))