gnu/system/u-boot.scm

[Danny Milosavljevic]

Hi,

below is my (untested!) attempt at an u-boot-configuration for use like this

  (bootloader (u-boot-configuration (device "/dev/sda")))

.

It has been copied from gnu/system/grub.cfg and then I s/grub/u-boot/g and 
removed all the eyecandy stuff as far as I could. We should end up with U-Boot 
showing a boot menu if 

(1) The file "extlinux.conf" ends up on the first partition in the root if no 
partition was marked Active or
(2) The file "extlinux.conf" ends up on the partition which was marked Active 
using the flag in the MBR/GPT.

and if someone installed u-boot-sunxi-with-spl.bin at a special sector using dd 
or something.

NB: I think "device" would better be called "drive" or something. Everything is 
a device at this point. More important is that it isn't a partition or a 
scanner or something :)

Now how do I make u-boot-configuration available in my /etc/config.scm ? :)

NB: I also researched how to chainload grub and there's 
https://wiki.linaro.org/LEG/Engineering/Kernel/GRUBonUBOOT that describes it. 
Do we want that?

NB: menu-entry is unchanged. Might make sense to generalize it and move it to a 
common location.

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <address@hidden>
;;; Copyright © 2016 Danny Milosavljevic <address@hidden>
;;;
;;; 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)
  #:autoload   (gnu packages compression) (gzip)
  #: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-device

            menu-entry
            menu-entry?

            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-configuration-board)           ; string ; not 
optional!
  (u-boot          u-boot-configuration-u-boot           ; package
                   (default (@ (gnu packages u-boot) (make-u-boot-package 
board))))
  (device          u-boot-configuration-device)        ; 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-record-type* <menu-entry>
  menu-entry make-menu-entry
  menu-entry?
  (label           menu-entry-label)
  (linux           menu-entry-linux)
  (linux-arguments menu-entry-linux-arguments
                   (default '()))          ; list of string-valued gexps
  (initrd          menu-entry-initrd))     ; file name of the initrd as a gexp




(define (eye-candy config root-fs system port)
  "dummy"
  (mlet* %store-monad ((image #f))
    (return (and image
                 #~(format #$port "")))))



;;;
;;; 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)
      #~(format port "LABEL ~s
  MENU LABEL ~a
  LINUX ~a/~a ~a
  INITRD ~a
  FDTDIR .
  APPEND ~a
~%"
                #$label
                #$linux #$linux-image-name
                #$initrd
                (string-join (list address@hidden))))))

  (mlet %store-monad ((sugar (eye-candy config store-fs system #~port)))
    (define builder
      #~(call-with-output-file #$output
          (lambda (port)
            #$sugar
            (format port "
ui menu.c32
DEFAULT ~a
TIMEOUT ~a~%"
                    #$(u-boot-configuration-default-entry config)
                    #$(u-boot-configuration-timeout config))
            #$@(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