diff mbox

wip v2 u-boot support

Message ID 20160909020253.0ee7273d@scratchpost.org
State New
Headers show

Commit Message

Danny Milosavljevic Sept. 9, 2016, 12:02 a.m. UTC
New wip patch attached - applies to git guix...

Comments

David Craven Sept. 9, 2016, 12:02 p.m. UTC | #1
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)>
Danny Milosavljevic Sept. 9, 2016, 2:57 p.m. UTC | #2
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?
David Craven Sept. 9, 2016, 3:29 p.m. UTC | #3
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
diff mbox

Patch

diff --git a/gnu.scm b/gnu.scm
index 932e4cd..9207e38 100644
--- a/gnu.scm
+++ b/gnu.scm
@@ -35,6 +35,7 @@ 
         (gnu system mapped-devices)
         (gnu system file-systems)
         (gnu system grub)                         ; 'grub-configuration'
+        (gnu system u-boot)                       ; 'u-boot-configuration'
         (gnu system pam)
         (gnu system shadow)                       ; 'user-account'
         (gnu system linux-initrd)
diff --git a/gnu/build/install.scm b/gnu/build/install.scm
index 7431a09..92740d5 100644
--- a/gnu/build/install.scm
+++ b/gnu/build/install.scm
@@ -21,7 +21,7 @@ 
   #:use-module (guix build store-copy)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 match)
-  #:export (install-grub
+  #:export (install-bootloader
             populate-root-file-system
             reset-timestamps
             register-closure
@@ -36,28 +36,49 @@ 
 ;;;
 ;;; Code:
 
-(define* (install-grub grub.cfg device mount-point)
+(define* (install-bootloader-config source target)
+  (let* ((pivot  (string-append target ".new")))
+    (mkdir-p (dirname target))
+
+    ;; Copy bootloader config file instead of just symlinking it, because symlinks won't
+    ;; work when /boot is on a separate partition.  Do that atomically.
+    (copy-file source pivot)
+    (rename-file pivot target)))
+
+(define* (install-grub grub-name grub.cfg device mount-point)
   "Install GRUB with GRUB.CFG on DEVICE, which is assumed to be mounted on
-MOUNT-POINT.
+MOUNT-POINT. FIXME is that correct?
 
 Note that the caller must make sure that GRUB.CFG is registered as a GC root
 so that the fonts, background images, etc. referred to by GRUB.CFG are not
 GC'd."
-  (let* ((target (string-append mount-point "/boot/grub/grub.cfg"))
-         (pivot  (string-append target ".new")))
-    (mkdir-p (dirname target))
-
-    ;; Copy GRUB.CFG instead of just symlinking it, because symlinks won't
-    ;; work when /boot is on a separate partition.  Do that atomically.
-    (copy-file grub.cfg pivot)
-    (rename-file pivot target)
-
+  (let ((target (string-append mount-point "/boot/grub/grub.cfg")))
+    (install-bootloader-config grub.cfg target)
     (unless (zero? (system* "grub-install" "--no-floppy"
                             "--boot-directory"
                             (string-append mount-point "/boot")
                             device))
       (error "failed to install GRUB"))))
 
+(define* (install-u-boot u-boot-name extlinux.conf device mount-point)
+  "Install U-Boot with EXTLINUX.CONF on DEVICE, which is assumed to be mounted on
+MOUNT-POINT. FIXME is that correct?"
+    (install-bootloader-config extlinux.conf
+                               (string-append mount-point
+                                              "/extlinux.conf"))
+    (unless (zero? (system* (string-append u-boot-name "/bin/u-boot-install")
+                            (string-append "--boot-directory=" mount-point)
+                            device))
+      (error "failed to install U-Boot")))
+
+(define* (install-bootloader package-output-name config-filename device mount-point)
+  "Install bootloader with CONFIG-FILENAME on DEVICE, which is assumed to be
+mounted on MOUNT-POINT."
+  (let* ((grub? (string-contains package-output-name "grub"))
+         (bootloader-installer (if grub? install-grub
+                                         install-u-boot)))
+    (bootloader-installer package-output-name config-filename device mount-point)))
+
 (define (evaluate-populate-directive directive target)
   "Evaluate DIRECTIVE, an sexp describing a file or directory to create under
 directory TARGET."
diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index cc5cf45..2e2079e 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -295,6 +295,7 @@  SYSTEM-DIRECTORY is the name of the directory of the 'system' derivation."
 
 (define* (initialize-hard-disk device
                                #:key
+                               grub
                                grub.cfg
                                (partitions '()))
   "Initialize DEVICE as a disk containing all the <partition> objects listed
@@ -313,7 +314,7 @@  passing it a directory name where it is mounted."
     (display "mounting root partition...\n")
     (mkdir-p target)
     (mount (partition-device root) target (partition-file-system root))
-    (install-grub grub.cfg device target)
+    (install-bootloader grub grub.cfg device target)
 
     ;; Register GRUB.CFG as a GC root.
     (register-grub.cfg-root target grub.cfg)
diff --git a/gnu/system.scm b/gnu/system.scm
index 0802010..0c54f8f 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -47,6 +47,7 @@ 
   #:use-module (gnu services shepherd)
   #:use-module (gnu services base)
   #:use-module (gnu system grub)
+  #:use-module (gnu system u-boot)
   #:use-module (gnu system shadow)
   #:use-module (gnu system nss)
   #:use-module (gnu system locale)
@@ -89,6 +90,7 @@ 
 
             operating-system-derivation
             operating-system-profile
+            operating-system-grub
             operating-system-grub.cfg
             operating-system-etc-directory
             operating-system-locale-directory
@@ -703,6 +705,22 @@  listed in OS.  The C library expects to find it under
   "Return the file system that contains the store of OS."
   (store-file-system (operating-system-file-systems os)))
 
+(define (operating-system-grub os)
+  (match (operating-system-bootloader os)
+    ((? grub-configuration? config)
+     (grub-configuration-package config os))
+    ((? u-boot-configuration? config)
+     (u-boot-configuration-package config os))))
+
+(define* (bootloader-configuration-file config store-fs entries
+                                        #:key
+                                        (system (%current-system))
+                                        (old-entries '()))
+  ((match config
+    ((? grub-configuration? config) grub-configuration-file)
+    ((? u-boot-configuration? config) u-boot-configuration-file))
+    config store-fs entries #:system system #:old-entries old-entries))
+
 (define* (operating-system-grub.cfg os #:optional (old-entries '()))
   "Return the GRUB configuration file for OS.  Use OLD-ENTRIES to populate the
 \"old entries\" menu."
@@ -724,7 +742,7 @@  listed in OS.  The C library expects to find it under
                                                     "/boot")
                                    (operating-system-kernel-arguments os)))
                            (initrd #~(string-append #$system "/initrd"))))))
-    (grub-configuration-file (operating-system-bootloader os)
+    (bootloader-configuration-file (operating-system-bootloader os)
                              store-fs entries
                              #:old-entries old-entries)))
 
diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm
index 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)))))
 
 
 ;;;
@@ -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))