unofficial mirror of guix-devel@gnu.org 
 help / color / mirror / code / Atom feed
* wip u-boot support
@ 2016-09-05 19:58 Danny Milosavljevic
  2016-09-05 20:29 ` wip v2 " Danny Milosavljevic
  0 siblings, 1 reply; 17+ messages in thread
From: Danny Milosavljevic @ 2016-09-05 19:58 UTC (permalink / raw)
  To: David Craven; +Cc: guix-devel

[-- Attachment #1: Type: text/plain, Size: 1562 bytes --]

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.

[-- Attachment #2: wip-uboot-support.patch --]
[-- Type: text/x-patch, Size: 12463 bytes --]

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..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-derivation
             operating-system-profile
+            operating-system-grub
             operating-system-grub.cfg
             operating-system-etc-directory
             operating-system-locale-directory
@@ -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
             grub-configuration?
+            grub-configuration-package
             grub-configuration-device
 
             menu-entry
@@ -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-configuration-board
-            u-boot-configuration-u-boot
+            u-boot-configuration-package
             u-boot-configuration-device
             u-boot-configuration-file))
 
@@ -61,6 +61,10 @@
 
 \f
 
+(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")
                      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     (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)
                    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)))))
 
 \f
 ;;;
@@ -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))

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: u-boot.scm --]
[-- Type: text/x-scheme, Size: 5623 bytes --]

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Danny Milosavljevic <dannym@scratchpost.org>
;;; Copyright © 2016 David Craven <david@craven.ch>
;;;
;;; 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 packages u-boot)
  #:use-module (guix build-system gnu)
  #:use-module (guix download)
  #:use-module (guix packages)
  #:use-module ((guix licenses) #:prefix license:)
  #:use-module (gnu packages)
  #:use-module ((gnu packages algebra) #:select (bc))
  #:use-module (gnu packages bison)
  #:use-module (gnu packages cross-base)
  #:use-module (gnu packages flex)
  #:use-module (gnu packages python))

(define-public dtc
  (package
    (name "dtc")
    (version "1.4.2")
    (source (origin
              (method url-fetch)
              (uri (string-append
                    "https://www.kernel.org/pub/software/utils/dtc/"
                    "dtc-" version ".tar.xz"))
              (sha256
               (base32
                "1b7si8niyca4wxbfah3qw4p4wli81mc1qwfhaswvrfqahklnwi8k"))))
    (build-system gnu-build-system)
    (native-inputs
     `(("bison" ,bison)
       ("flex" ,flex)))
    (arguments
     `(#:make-flags
       (list "CC=gcc" (string-append "PREFIX=" (assoc-ref %outputs "out")))
       #:phases
       (modify-phases %standard-phases
         (add-after 'unpack 'patch-paths
           (lambda _
             (substitute* "Makefile"
               (("/usr/bin/install") "install"))
             (substitute* "Makefile"
               (("PREFIX = \\$\\(HOME\\)") ""))))
         (delete 'configure))))
    (home-page "https://www.devicetree.org")
    (synopsis "Compiles device tree source files")
    (description "@command{dtc} compiles device tree source files to device
tree binary files. These are board description files used by Linux and BSD.")
    (license license:gpl2+)))

(define u-boot
  (package
    (name "u-boot")
    (version "2016.07")
    (source (origin
              (method url-fetch)
              (uri (string-append
                    "ftp://ftp.denx.de/pub/u-boot/"
                    "u-boot-" version ".tar.bz2"))
              (sha256
               (base32
                "0lqj4ckmfqiap8mc6z2d5albs3g2h5mzccbn60hsgxhabhibfkwp"))))
    (native-inputs
     `(("bc" ,bc)
       ("dtc" ,dtc)
       ("python-2" ,python-2)))
    (build-system  gnu-build-system)
    (home-page "http://www.denx.de/wiki/U-Boot/")
    (synopsis "ARM bootloader")
    (description "U-Boot is a bootloader used mostly for ARM boards. It
also initializes the boards (RAM etc).")
    (license license:gpl2+)))

(define (make-u-boot-package board triplet)
  "Returns a u-boot package for BOARD cross-compiled for TRIPLET."
  (package
    (inherit u-boot)
    (name (string-append "u-boot-" (string-downcase board)))
    (native-inputs
     `(("cross-gcc" ,(cross-gcc triplet))
       ("cross-binutils" ,(cross-binutils triplet))
       ,@(package-native-inputs u-boot)))
    (arguments
     `(#:test-target "test"
       #:make-flags
       (list "HOSTCC=gcc" (string-append "CROSS_COMPILE=" ,triplet "-"))
       #:phases
       (modify-phases %standard-phases
         (replace 'configure
           (lambda* (#:key outputs make-flags #:allow-other-keys)
             (let ((config-name (string-append ,board "_defconfig")))
               (if (file-exists? (string-append "configs/" config-name))
                   (zero? (apply system* "make" `(,@make-flags ,config-name)))
                   (begin
                     (display "Invalid board name. Valid board names are:")
                     (let ((dir (opendir "configs"))
                           (suffix-length (string-length "_defconfig")))
                       (do ((file-name (readdir dir) (readdir dir)))
                           ((eof-object? file-name))
                         (when (string-suffix? "_defconfig" file-name)
                           (format #t "- ~A\n"
                                   (string-drop-right file-name suffix-length))))
                       (closedir dir))
                     #f)))))
         (replace 'install
           (lambda* (#:key outputs make-flags #:allow-other-keys)
             (let* ((out (assoc-ref outputs "out"))
                    (libexec (string-append out "/libexec"))
                    (uboot-files (find-files "." ".*\\.(bin|efi|spl)$")))
               (mkdir-p libexec)
               (for-each
                (lambda (file)
                  (let ((target-file (string-append libexec "/" file)))
                    (mkdir-p (dirname target-file))
                    (copy-file file target-file)))
                uboot-files)))))))))

(define-public u-boot-vexpress_ca9x4
  (make-u-boot-package "vexpress_ca9x4" "arm-linux-gnueabihf"))

(define-public u-boot-malta
  (make-u-boot-package "malta" "mips64el-linux-gnuabi64"))

^ permalink raw reply related	[flat|nested] 17+ messages in thread

* wip v2 u-boot support
  2016-09-05 19:58 wip u-boot support Danny Milosavljevic
@ 2016-09-05 20:29 ` Danny Milosavljevic
  2016-09-06 16:34   ` David Craven
  0 siblings, 1 reply; 17+ messages in thread
From: Danny Milosavljevic @ 2016-09-05 20:29 UTC (permalink / raw)
  To: David Craven; +Cc: guix-devel

[-- Attachment #1: Type: text/plain, Size: 1756 bytes --]

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.

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: u-boot.scm --]
[-- Type: text/x-scheme, Size: 4473 bytes --]

;;; 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-board
            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-configuration-board)           ; string ; not optional!
  (u-boot          u-boot-configuration-u-boot           ; package
                   (default #f)) ; will actually default to (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)))

\f

(define (u-boot-configuration-package config)
  (or (u-boot-configuration-u-boot config)
      (make-u-boot-package (u-boot-configuration-board config))))

;;;
;;; 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 ~a
  INITRD ~a
  FDTDIR .
  APPEND ~a
~%"
                #$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 ~d
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

[-- Attachment #3: wip-uboot-support.patch --]
[-- Type: text/x-patch, Size: 12463 bytes --]

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..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-derivation
             operating-system-profile
+            operating-system-grub
             operating-system-grub.cfg
             operating-system-etc-directory
             operating-system-locale-directory
@@ -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
             grub-configuration?
+            grub-configuration-package
             grub-configuration-device
 
             menu-entry
@@ -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-configuration-board
-            u-boot-configuration-u-boot
+            u-boot-configuration-package
             u-boot-configuration-device
             u-boot-configuration-file))
 
@@ -61,6 +61,10 @@
 
 \f
 
+(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")
                      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     (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)
                    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)))))
 
 \f
 ;;;
@@ -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))

^ permalink raw reply related	[flat|nested] 17+ messages in thread

* Re: wip v2 u-boot support
  2016-09-05 20:29 ` wip v2 " Danny Milosavljevic
@ 2016-09-06 16:34   ` David Craven
  2016-09-08 22:09     ` David Craven
  0 siblings, 1 reply; 17+ messages in thread
From: David Craven @ 2016-09-06 16:34 UTC (permalink / raw)
  To: Danny Milosavljevic; +Cc: guix-devel

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...

Thanks!
David

^ permalink raw reply	[flat|nested] 17+ messages in thread

* Re: wip v2 u-boot support
  2016-09-06 16:34   ` David Craven
@ 2016-09-08 22:09     ` David Craven
  2016-09-08 23:57       ` Danny Milosavljevic
  2016-09-09  0:02       ` Danny Milosavljevic
  0 siblings, 2 replies; 17+ messages in thread
From: David Craven @ 2016-09-08 22:09 UTC (permalink / raw)
  To: Danny Milosavljevic; +Cc: guix-devel

Hi Danny,

I'm testing your new u-boot code. I fixed a few bugs, but there is
still some work to do... ;-)

guix system vm u-boot-test.scm --no-grub

This should work without giving any errors and boot (it doesn't matter
that u-boot is built for arm). And after booting there should be the
extlinux.conf file.

Below is a test operating-system and the stuff I've already fixed.

(use-modules (gnu))
(use-package-modules linux u-boot)
(use-service-modules base networking ssh)

(operating-system
  (host-name "beagle-bone-black")
  (timezone "Europe/Zurich")
  (locale "en_US.UTF-8")

  (bootloader (u-boot-configuration
               (u-boot u-boot-beagle-bone-black)))
  (kernel linux-libre) ; linux-libre-beagle-bone-black

  (file-systems
   (cons
    (file-system
      (mount-point "/")
      (type "ext4")
      (title 'label)
      (device "root"))
    %base-file-systems))

  (users
   (cons*
    (user-account
     (name "test")
     (group "users")
     (supplementary-groups '("wheel" "video"))
     (home-directory "/home/test")
     (password "sa5JEXtYx/rm6")) ; Password is pass.
    %base-user-accounts))

  (services
   (cons*
    (dropbear-service)
    (dhcp-client-service)
    %base-services)))

diff --git a/gnu/system.scm b/gnu/system.scm
index 24e4e15..153f7b0 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -733,9 +733,16 @@ 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)
-                             store-fs entries
-                             #:old-entries old-entries)))
+
+    (match (operating-system-bootloader os)
+      ((? grub-configuration? config)
+       (grub-configuration-file (operating-system-bootloader os)
+                                store-fs entries
+                                #:old-entries old-entries))
+      ((? u-boot-configuration? config)
+       (u-boot-configuration-file (operating-system-bootloader os)
+                                  store-fs entries
+                                  #:old-entries old-entries)))))

 (define (operating-system-parameters-file os)
   "Return a file that describes the boot parameters of OS.  The primary use of
diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm
index 4c9da8c..c3d2efb 100644
--- a/gnu/system/grub.scm
+++ b/gnu/system/grub.scm
@@ -52,6 +52,7 @@
             grub-configuration-package
             grub-configuration-device

+            <menu-entry>
             menu-entry
             menu-entry?

diff --git a/gnu/system/u-boot.scm b/gnu/system/u-boot.scm
index 00a0165..d56f75e 100644
--- a/gnu/system/u-boot.scm
+++ b/gnu/system/u-boot.scm
@@ -48,10 +48,7 @@
 (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 #f)) ; will actually default to
(make-u-boot-package board)
-  (device          u-boot-configuration-device)        ; string
+  (u-boot          u-boot-configuration-u-boot)        ; package
   (menu-entries    u-boot-configuration-menu-entries   ; list
                    (default '()))
   (default-entry   u-boot-configuration-default-entry  ; integer
@@ -96,7 +93,7 @@ corresponding to old generations of the system."
   FDTDIR .
   APPEND ~a
 ~%"
-                #$label
+                #$label #$label
                 #$linux #$linux-image-name
                 #$initrd
                 (string-join (list #$@arguments))))))

^ permalink raw reply related	[flat|nested] 17+ messages in thread

* Re: wip v2 u-boot support
  2016-09-08 22:09     ` David Craven
@ 2016-09-08 23:57       ` Danny Milosavljevic
  2016-09-09  0:02       ` Danny Milosavljevic
  1 sibling, 0 replies; 17+ messages in thread
From: Danny Milosavljevic @ 2016-09-08 23:57 UTC (permalink / raw)
  To: David Craven, ludo; +Cc: guix-devel

Hi David,
Hi Ludo,

On Fri, 9 Sep 2016 00:09:57 +0200
David Craven <david@craven.ch> wrote:

> I'm testing your new u-boot code. I fixed a few bugs, but there is
> still some work to do... ;-)
> 
> guix system vm u-boot-test.scm --no-grub
> 
> This should work without giving any errors and boot (it doesn't matter
> that u-boot is built for arm). And after booting there should be the
> extlinux.conf file.
> 
> Below is a test operating-system and the stuff I've already fixed.

Nice!

> --- a/gnu/system/grub.scm
> +++ b/gnu/system/grub.scm
> +            <menu-entry>

Ludo was against that because it makes other packages aware how the data structure <menu-entry> is implemented. Can it be avoided?

The only place where it's used externally:

gnu/system/u-boot.scm (copied from gnu/system/grub.scm where it was also used):

(define (u-boot-configuration-file ...)
 (define entry->gexp
  (match-lambda
    (($ <menu-entry> label linux ...
        ^^^^^^

Probably something like

 (? menu-entry? ...)
...   (menu-entry-label ...)
   ... (menu-entry-linux ...)

, right?

> -                #$label
> +                #$label #$label

Indeed.

I fixed the guix system vm problem by modifying 

  gnu/system/vm.scm

to say

  (package->derivation (operating-system-grub os))

instead of

  (operating-system-grub os)

in two places.

Now it failed because someone in gnu/system.scm used grub-configuration-file on a <u-boot-configuration> :P

So replace the call of grub-configuration-file by bootloader-configuration-file, add it as follows:

(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))

Then it complained about the built-in "format" not knowing "~d" which is used by gnu/system/u-boot.scm at the bottom. So change that to "~a".

Then it complained about gnu/system/u-boot.scm entry->gexp. Replace "~a/~a ~a" by "~a/~a".

It then successfully built a VM for me with your config.

@Ludo: Not sure where the step from package to derivation is supposed to be done (it works at that place - but is it the right place?). In the end, the build side needs to know the name of the bootloader installation directory in order to be able to read the image to install in the boot sector etc, right? And that is a way.

^ permalink raw reply	[flat|nested] 17+ messages in thread

* Re: wip v2 u-boot support
  2016-09-08 22:09     ` David Craven
  2016-09-08 23:57       ` Danny Milosavljevic
@ 2016-09-09  0:02       ` Danny Milosavljevic
  2016-09-09 12:02         ` David Craven
  1 sibling, 1 reply; 17+ messages in thread
From: Danny Milosavljevic @ 2016-09-09  0:02 UTC (permalink / raw)
  To: David Craven; +Cc: guix-devel

[-- Attachment #1: Type: text/plain, Size: 48 bytes --]

New wip patch attached - applies to git guix...

[-- Attachment #2: uboot.patch --]
[-- Type: text/x-patch, Size: 13543 bytes --]

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 45b46ca..a6b884f 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/mapped-devices.scm b/gnu/system/mapped-devices.scm
index 2ce35ea..9a9a8bb 100644
--- a/gnu/system/mapped-devices.scm
+++ b/gnu/system/mapped-devices.scm
@@ -105,7 +105,7 @@
                       #:select (find-partition-by-luks-uuid)))
 
         (zero? (system* (string-append #$cryptsetup "/sbin/cryptsetup")
-                        "open" "--type" "luks"
+                        "open" "--type" "luks" "-v" "--key-file=/dev/sdb3" "--keyfile-size=64"
 
                         ;; Note: We cannot use the "UUID=source" syntax here
                         ;; because 'cryptsetup' implements it by searching the
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)))))
 
 \f
 ;;;
@@ -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))

^ permalink raw reply related	[flat|nested] 17+ messages in thread

* Re: wip v2 u-boot support
  2016-09-09  0:02       ` Danny Milosavljevic
@ 2016-09-09 12:02         ` David Craven
  2016-09-09 14:35           ` Danny Milosavljevic
  2016-09-09 14:57           ` Danny Milosavljevic
  0 siblings, 2 replies; 17+ messages in thread
From: David Craven @ 2016-09-09 12:02 UTC (permalink / raw)
  To: Danny Milosavljevic; +Cc: guix-devel

It still doesn't work. Can you please also include gnu system u-boot
in the patch? or make it a separate patch if you want. It's nice if
you can simply apply (all required) patches and things just work. I
expect patches to work before I spend time looking at the code, but
maybe I'm just old fashioned (or new fashioned?)

Backtrace:
In ice-9/boot-9.scm:
 157: 18 [catch #t #<catch-closure 1cf5960> ...]
In unknown file:
   ?: 17 [apply-smob/1 #<catch-closure 1cf5960>]
In ice-9/boot-9.scm:
  63: 16 [call-with-prompt prompt0 ...]
In ice-9/eval.scm:
 432: 15 [eval # #]
In ice-9/boot-9.scm:
2401: 14 [save-module-excursion #<procedure 1d13940 at
ice-9/boot-9.scm:4045:3 ()>]
4050: 13 [#<procedure 1d13940 at ice-9/boot-9.scm:4045:3 ()>]
1724: 12 [%start-stack load-stack ...]
1729: 11 [#<procedure 1d29ea0 ()>]
In unknown file:
   ?: 10 [primitive-load "/home/dvc/guix/scripts/guix"]
In guix/ui.scm:
1192: 9 [run-guix-command system "vm" "arm-disk-image.scm" "--no-grub"]
In ice-9/boot-9.scm:
 157: 8 [catch srfi-34 #<procedure 4ba2760 at guix/ui.scm:423:2 ()> ...]
 157: 7 [catch system-error ...]
In guix/scripts/system.scm:
 876: 6 [#<procedure 4b7e030 at guix/scripts/system.scm:868:2 ()>]
 782: 5 [process-action vm ("arm-disk-image.scm") ...]
In guix/store.scm:
1182: 4 [run-with-store # ...]
In guix/scripts/system.scm:
 556: 3 [#<procedure 535a7e0 at guix/scripts/system.scm:556:2 (state)> #]
In gnu/system/vm.scm:
 484: 2 [#<procedure 7ce9870 at gnu/system/vm.scm:484:2 (state)> #]
 424: 1 [#<procedure 7cf0440 at gnu/system/vm.scm:423:2 (state)> #]
In ice-9/eval.scm:
 416: 0 [u-boot-configuration-package # #]

ice-9/eval.scm:416:20: In procedure u-boot-configuration-package:
ice-9/eval.scm:416:20: Wrong number of arguments to #<procedure
u-boot-configuration-package (a)>

^ permalink raw reply	[flat|nested] 17+ messages in thread

* Re: wip v2 u-boot support
  2016-09-09 12:02         ` David Craven
@ 2016-09-09 14:35           ` Danny Milosavljevic
  2016-09-09 14:57           ` Danny Milosavljevic
  1 sibling, 0 replies; 17+ messages in thread
From: Danny Milosavljevic @ 2016-09-09 14:35 UTC (permalink / raw)
  To: David Craven; +Cc: guix-devel

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

^ permalink raw reply related	[flat|nested] 17+ messages in thread

* Re: wip v2 u-boot support
  2016-09-09 12:02         ` David Craven
  2016-09-09 14:35           ` Danny Milosavljevic
@ 2016-09-09 14:57           ` Danny Milosavljevic
  2016-09-09 15:29             ` David Craven
  1 sibling, 1 reply; 17+ messages in thread
From: Danny Milosavljevic @ 2016-09-09 14:57 UTC (permalink / raw)
  To: David Craven; +Cc: guix-devel

[-- Attachment #1: Type: text/plain, Size: 1981 bytes --]

Hi David,

On Fri, 9 Sep 2016 14:02:53 +0200
David Craven <david@craven.ch> wrote:

> It still doesn't work. Can you please also include gnu system u-boot
> in the patch? 

git randomly decided to leave things off the patch when I do "git diff". Sigh.

> It's nice if you can simply apply (all required) patches and things just work. I
> expect patches to work before I spend time looking at the code, but
> maybe I'm just old fashioned (or new fashioned?)

It's understandable and I'd expect the same.

I'm at a loss of what I should do when my tools work against me - I can just write a git diff replacement but at some point I'm reinventing everything. I've had that feeling for some years now that many dev tools the free software community uses are broken in strange ways and nobody fixes it or can even find the original cause or design decision. Often there's an arcane setting (or worse, extra workflow steps) which you can use to unbreak it - but this is not the way things should be.

Anyway, attached gnu/system/u-boot.scm which it left off *again* (after git add, even). (How is having a new file not a *diff*erence? Sigh)

= Overall Design =

As for the overall design, I'm not sure whether I want a separate u-boot-configuration (as opposed reusing grub-configuration for u-boot).

grub-configuration-file could just return a list of config files, the grub config file AND the u-boot config file. Guix could install them both and there would be no need for u-boot-configuration. The only thing we would need is a field in grub-configuration to specify what to install as bootloader ("installer" or "package" or whatever). (for grub it would say grub and for u-boot it would say (make-u-boot-package ...). If the user doesn't specify a value it would just not install any bootloader - which means we could dispense with --no-grub etc.

The users of grub-configuration-file would have to handle lists. That's the only things we would need to change. What do you think?

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: grub.scm --]
[-- Type: text/x-scheme, Size: 10516 bytes --]

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.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 grub)
  #: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 grub) (grub)
  #:autoload   (gnu packages inkscape) (inkscape)
  #:autoload   (gnu packages imagemagick) (imagemagick)
  #:autoload   (gnu packages compression) (gzip)
  #:use-module (ice-9 match)
  #:use-module (ice-9 regex)
  #:use-module (srfi srfi-1)
  #:export (grub-image
            grub-image?
            grub-image-aspect-ratio
            grub-image-file

            grub-theme
            grub-theme?
            grub-theme-images
            grub-theme-color-normal
            grub-theme-color-highlight

            %background-image
            %default-theme

            grub-configuration
            grub-configuration?
            grub-configuration-package
            grub-configuration-device

            <menu-entry>
            menu-entry
            menu-entry?

            grub-configuration-file))

;;; Commentary:
;;;
;;; Configuration of GNU GRUB.
;;;
;;; Code:

(define-record-type* <grub-image>
  grub-image make-grub-image
  grub-image?
  (aspect-ratio    grub-image-aspect-ratio        ;rational number
                   (default 4/3))
  (file            grub-image-file))              ;file-valued gexp (SVG)

(define-record-type* <grub-theme>
  grub-theme make-grub-theme
  grub-theme?
  (images          grub-theme-images
                   (default '()))                 ;list of <grub-image>
  (color-normal    grub-theme-color-normal
                   (default '((fg . cyan) (bg . blue))))
  (color-highlight grub-theme-color-highlight
                   (default '((fg . white) (bg . blue)))))

(define %background-image
  (grub-image
   (aspect-ratio 4/3)
   (file #~(string-append #$%artwork-repository
                          "/grub/GuixSD-fully-black-4-3.svg"))))

(define %default-theme
  ;; Default theme contributed by Felipe López.
  (grub-theme
   (images (list %background-image))
   (color-highlight '((fg . yellow) (bg . black)))
   (color-normal    '((fg . light-gray) (bg . black))))) ;XXX: #x303030

(define-record-type* <grub-configuration>
  grub-configuration make-grub-configuration
  grub-configuration?
  (grub            grub-configuration-grub           ; package
                   (default (@ (gnu packages grub) grub)))
  (device          grub-configuration-device)        ; string
  (menu-entries    grub-configuration-menu-entries   ; list
                   (default '()))
  (default-entry   grub-configuration-default-entry  ; integer
                   (default 0))
  (timeout         grub-configuration-timeout        ; integer
                   (default 5))
  (theme           grub-configuration-theme          ; <grub-theme>
                   (default %default-theme)))

(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

\f
;;;
;;; Background image & themes.
;;;

(define (svg->png svg)
  "Build a PNG from SVG."
  ;; Don't use #:local-build? so that it's substitutable.
  (gexp->derivation "grub-image.png"
                    #~(zero?
                       (system* (string-append #$inkscape "/bin/inkscape")
                                "--without-gui"
                                (string-append "--export-png=" #$output)
                                #$svg))))

(define (resize-image image width height)
  "Resize IMAGE to WIDTHxHEIGHT."
  ;; Don't use #:local-build? so that it's substitutable.
  (let ((size (string-append (number->string width)
                             "x" (number->string height))))
    (gexp->derivation "grub-image.resized.png"
                      #~(zero?
                         (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."
  (let* ((ratio (/ width height))
         (image (find (lambda (image)
                        (= (grub-image-aspect-ratio image) ratio))
                      (grub-theme-images (grub-configuration-theme config)))))
    (if image
        (mlet %store-monad ((png (svg->png (grub-image-file image))))
          (resize-image png width height))
        (with-monad %store-monad
          (return #f)))))

(define (eye-candy config root-fs system port)
  "Return in %STORE-MONAD a gexp that writes to PORT (a port-valued gexp) the
'grub.cfg' part concerned with graphics mode, background images, colors, and
all that.  ROOT-FS is a file-system object denoting the root file system where
the store is.  SYSTEM must be the target system string---e.g.,
\"x86_64-linux\"."
  (define setup-gfxterm-body
    ;; Intel systems need to be switched into graphics mode, whereas most
    ;; other modern architectures have no other mode and therefore don't need
    ;; to be switched.
    (if (string-match "^(x86_64|i[3-6]86)-" system)
        "
  # Leave 'gfxmode' to 'auto'.
  insmod vbe
  insmod vga
  insmod video_bochs
  insmod video_cirrus
  insmod gfxterm
  terminal_output gfxterm
"
        ""))

  (define (theme-colors type)
    (let* ((theme  (grub-configuration-theme config))
           (colors (type theme)))
      (string-append (symbol->string (assoc-ref colors 'fg)) "/"
                     (symbol->string (assoc-ref colors 'bg)))))

  (define font-file
    #~(string-append #$grub "/share/grub/unicode.pf2"))

  (mlet* %store-monad ((image (grub-background-image config)))
    (return (and image
                 #~(format #$port "
function setup_gfxterm {~a}

# Set 'root' to the partition that contains /gnu/store.
~a

if loadfont ~a; then
  setup_gfxterm
fi

insmod png
if background_image ~a; then
  set color_normal=~a
  set color_highlight=~a
else
  set menu_color_normal=cyan/blue
  set menu_color_highlight=white/blue
fi~%"
                           #$setup-gfxterm-body
                           #$(grub-root-search root-fs font-file)
                           #$font-file

                           #$image
                           #$(theme-colors grub-theme-color-normal)
                           #$(theme-colors grub-theme-color-highlight))))))

\f
;;;
;;; Configuration file.
;;;

(define (grub-root-search root-fs file)
  "Return the GRUB 'search' command to look for ROOT-FS, which contains FILE,
a gexp.  The result is a gexp that can be inserted in the grub.cfg-generation
code."
  (case (file-system-title root-fs)
    ;; Preferably refer to ROOT-FS by its UUID or label.  This is more
    ;; efficient and less ambiguous, see <>.
    ((uuid)
     (format #f "search --fs-uuid --set ~a"
             (uuid->string (file-system-device root-fs))))
    ((label)
     (format #f "search --label --set ~a"
             (file-system-device root-fs)))
    (else
     ;; As a last resort, look for any device containing FILE.
     #~(format #f "search --file --set ~a" #$file))))

(define* (grub-configuration-file config store-fs entries
                                  #:key
                                  (system (%current-system))
                                  (old-entries '()))
  "Return the GRUB configuration file corresponding to CONFIG, a
<grub-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 (grub-configuration-menu-entries config)))

  (define entry->gexp
    (match-lambda
     (($ <menu-entry> label linux arguments initrd)
      #~(format port "menuentry ~s {
  ~a
  linux ~a/~a ~a
  initrd ~a
}~%"
                #$label
                #$(grub-root-search store-fs
                                    #~(string-append #$linux "/"
                                                     #$linux-image-name))
                #$linux #$linux-image-name (string-join (list #$@arguments))
                #$initrd))))

  (mlet %store-monad ((sugar (eye-candy config store-fs system #~port)))
    (define builder
      #~(call-with-output-file #$output
          (lambda (port)
            #$sugar
            (format port "
set default=~a
set timeout=~a~%"
                    #$(grub-configuration-default-entry config)
                    #$(grub-configuration-timeout config))
            #$@(map entry->gexp all-entries)

            #$@(if (pair? old-entries)
                   #~((format port "
submenu \"GNU system, old configurations...\" {~%")
                      #$@(map entry->gexp old-entries)
                      (format port "}~%"))
                   #~()))))

    (gexp->derivation "grub.cfg" builder)))

;;; grub.scm ends here

^ permalink raw reply	[flat|nested] 17+ messages in thread

* Re: wip v2 u-boot support
  2016-09-09 14:57           ` Danny Milosavljevic
@ 2016-09-09 15:29             ` David Craven
  2016-09-09 18:09               ` [WIP PATCH] gnu: add U-Boot support to operating-system configuration Danny Milosavljevic
  0 siblings, 1 reply; 17+ messages in thread
From: David Craven @ 2016-09-09 15:29 UTC (permalink / raw)
  To: Danny Milosavljevic; +Cc: guix-devel

Hi Danny,

> Anyway, attached gnu/system/u-boot.scm which it left off *again* (after git add, even). (How is having a new file not a *diff*erence? Sigh)

`git add -N .` adds untracked files to the list of tracked ones. git
diff should then work as expected.

I'm sorry to say that I can't apply your diffs :/

Can you please do the following?
git fetch origin master
git rebase -i origin/master and squash all your commits in to one big fat one
git format-patch -1
and manually attach the patch to an email in gmail or whatever =P

I'll then apply it to a clean checkout and we should get this thing working!

Thank you
David

^ permalink raw reply	[flat|nested] 17+ messages in thread

* [WIP PATCH] gnu: add U-Boot support to operating-system configuration.
  2016-09-09 15:29             ` David Craven
@ 2016-09-09 18:09               ` Danny Milosavljevic
  2016-09-10 17:52                 ` David Craven
  0 siblings, 1 reply; 17+ messages in thread
From: Danny Milosavljevic @ 2016-09-09 18:09 UTC (permalink / raw)
  To: guix-devel, David Craven

[-- Attachment #1: Type: text/plain, Size: 456 bytes --]

---
 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


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-gnu-add-U-Boot-support-to-operating-system-configura.patch --]
[-- Type: text/x-patch; name="0001-gnu-add-U-Boot-support-to-operating-system-configura.patch", Size: 17916 bytes --]

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)))
+
+\f
+
+(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)))))
 
 \f
 ;;;
@@ -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))

^ permalink raw reply related	[flat|nested] 17+ messages in thread

* Re: [WIP PATCH] gnu: add U-Boot support to operating-system configuration.
  2016-09-09 18:09               ` [WIP PATCH] gnu: add U-Boot support to operating-system configuration Danny Milosavljevic
@ 2016-09-10 17:52                 ` David Craven
  2016-09-16 11:07                   ` Danny Milosavljevic
  0 siblings, 1 reply; 17+ messages in thread
From: David Craven @ 2016-09-10 17:52 UTC (permalink / raw)
  To: Danny Milosavljevic; +Cc: guix-devel

Thanks Danny! Awesome work! =) I'm really excited to see this hitting master...

^ permalink raw reply	[flat|nested] 17+ messages in thread

* Re: [WIP PATCH] gnu: add U-Boot support to operating-system configuration.
  2016-09-10 17:52                 ` David Craven
@ 2016-09-16 11:07                   ` Danny Milosavljevic
  2016-09-16 12:26                     ` Vincent Legoll
  0 siblings, 1 reply; 17+ messages in thread
From: Danny Milosavljevic @ 2016-09-16 11:07 UTC (permalink / raw)
  To: David Craven, guix-devel, ludo

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.

^ permalink raw reply	[flat|nested] 17+ messages in thread

* Re: [WIP PATCH] gnu: add U-Boot support to operating-system configuration.
  2016-09-16 11:07                   ` Danny Milosavljevic
@ 2016-09-16 12:26                     ` Vincent Legoll
  2016-09-17  7:47                       ` David Craven
  0 siblings, 1 reply; 17+ messages in thread
From: Vincent Legoll @ 2016-09-16 12:26 UTC (permalink / raw)
  To: Danny Milosavljevic; +Cc: guix-devel

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.

-- 
Vincent Legoll

^ permalink raw reply	[flat|nested] 17+ messages in thread

* Re: [WIP PATCH] gnu: add U-Boot support to operating-system configuration.
  2016-09-16 12:26                     ` Vincent Legoll
@ 2016-09-17  7:47                       ` David Craven
  2016-09-17 17:08                         ` David Craven
  0 siblings, 1 reply; 17+ messages in thread
From: David Craven @ 2016-09-17  7:47 UTC (permalink / raw)
  To: Vincent Legoll; +Cc: guix-devel

> 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...

^ permalink raw reply	[flat|nested] 17+ messages in thread

* Re: [WIP PATCH] gnu: add U-Boot support to operating-system configuration.
  2016-09-17  7:47                       ` David Craven
@ 2016-09-17 17:08                         ` David Craven
  2016-09-24  4:16                           ` Ludovic Courtès
  0 siblings, 1 reply; 17+ messages in thread
From: David Craven @ 2016-09-17 17:08 UTC (permalink / raw)
  To: Vincent Legoll; +Cc: guix-devel

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

^ permalink raw reply	[flat|nested] 17+ messages in thread

* Re: [WIP PATCH] gnu: add U-Boot support to operating-system configuration.
  2016-09-17 17:08                         ` David Craven
@ 2016-09-24  4:16                           ` Ludovic Courtès
  0 siblings, 0 replies; 17+ messages in thread
From: Ludovic Courtès @ 2016-09-24  4:16 UTC (permalink / raw)
  To: David Craven; +Cc: guix-devel

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’.

^ permalink raw reply	[flat|nested] 17+ messages in thread

end of thread, other threads:[~2016-09-24  5:22 UTC | newest]

Thread overview: 17+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2016-09-05 19:58 wip u-boot support Danny Milosavljevic
2016-09-05 20:29 ` wip v2 " Danny Milosavljevic
2016-09-06 16:34   ` David Craven
2016-09-08 22:09     ` David Craven
2016-09-08 23:57       ` Danny Milosavljevic
2016-09-09  0:02       ` Danny Milosavljevic
2016-09-09 12:02         ` David Craven
2016-09-09 14:35           ` Danny Milosavljevic
2016-09-09 14:57           ` Danny Milosavljevic
2016-09-09 15:29             ` David Craven
2016-09-09 18:09               ` [WIP PATCH] gnu: add U-Boot support to operating-system configuration Danny Milosavljevic
2016-09-10 17:52                 ` David Craven
2016-09-16 11:07                   ` Danny Milosavljevic
2016-09-16 12:26                     ` Vincent Legoll
2016-09-17  7:47                       ` David Craven
2016-09-17 17:08                         ` David Craven
2016-09-24  4:16                           ` Ludovic Courtès

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).