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