~ruther/guix-local

735c6dd7faec036adbfa44d927c823ffa9ea1243 — Ludovic Courtès 12 years ago 413d535
gnu: Lower initrd makers from packages to monadic procedures.

* gnu/packages/linux-initrd.scm: Remove.
* gnu/system/linux-initrd.scm: New file.
* gnu-system.am (GNU_SYSTEM_MODULES): Adjust accordingly.
* gnu/system.scm (<operating-system>): Change default 'initrd' value
  to (gnu-system-initrd).
  (operating-system-derivation): Bind 'operating-system-initrd'.  Pass
  'menu-entry' an initrd file name instead of a package.
* gnu/system/grub.scm (grub-configuration-file): Expect 'initrd' to be
  file name.
M gnu-system.am => gnu-system.am +1 -1
@@ 128,7 128,6 @@ GNU_SYSTEM_MODULES =				\
  gnu/packages/libunwind.scm			\
  gnu/packages/lightning.scm			\
  gnu/packages/linux.scm			\
  gnu/packages/linux-initrd.scm			\
  gnu/packages/lout.scm				\
  gnu/packages/lsh.scm				\
  gnu/packages/lsof.scm				\


@@ 221,6 220,7 @@ GNU_SYSTEM_MODULES =				\
  gnu/system/dmd.scm				\
  gnu/system/grub.scm				\
  gnu/system/linux.scm				\
  gnu/system/linux-initrd.scm			\
  gnu/system/shadow.scm				\
  gnu/system/vm.scm


M gnu/system.scm => gnu/system.scm +8 -7
@@ 1,5 1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;


@@ 22,7 22,6 @@
  #:use-module (guix records)
  #:use-module (guix packages)
  #:use-module (guix derivations)
  #:use-module (gnu packages linux-initrd)
  #:use-module (gnu packages base)
  #:use-module (gnu packages bash)
  #:use-module (gnu packages admin)


@@ 31,6 30,7 @@
  #:use-module (gnu system grub)
  #:use-module (gnu system shadow)
  #:use-module (gnu system linux)
  #:use-module (gnu system linux-initrd)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)


@@ 58,8 58,8 @@
              (default grub))
  (bootloader-entries operating-system-bootloader-entries ; list
                      (default '()))
  (initrd operating-system-initrd
          (default gnu-system-initrd))
  (initrd operating-system-initrd                 ; monadic derivation
          (default (gnu-system-initrd)))

  (host-name operating-system-host-name)          ; string



@@ 321,8 321,9 @@ alias ll='ls -l'
                                     "--config" ,dmd-conf))))
       (kernel  ->  (operating-system-kernel os))
       (kernel-dir  (package-file kernel))
       (initrd  ->  (operating-system-initrd os))
       (initrd-file (package-file initrd))
       (initrd      (operating-system-initrd os))
       (initrd-file -> (string-append (derivation->output-path initrd)
                                      "/initrd"))
       (entries ->  (list (menu-entry
                           (label (string-append
                                   "GNU system with "


@@ 331,7 332,7 @@ alias ll='ls -l'
                           (linux kernel)
                           (linux-arguments `("--root=/dev/vda1"
                                              ,(string-append "--load=" boot)))
                           (initrd initrd))))
                           (initrd initrd-file))))
       (grub.cfg (grub-configuration-file entries))
       (extras   (links (delete-duplicates
                         (append (append-map service-inputs services)

M gnu/system/grub.scm => gnu/system/grub.scm +2 -5
@@ 1,5 1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;


@@ 41,7 41,7 @@
  (linux           menu-entry-linux)
  (linux-arguments menu-entry-linux-arguments
                   (default '()))
  (initrd          menu-entry-initrd))
  (initrd          menu-entry-initrd))            ; file name of the initrd

(define* (grub-configuration-file entries
                                  #:key (default-entry 1) (timeout 5)


@@ 66,10 66,7 @@ search.file ~a~%"
    (match-lambda
     (($ <menu-entry> label linux arguments initrd)
      (mlet %store-monad ((linux  (package-file linux "bzImage"
                                                #:system system))
                          (initrd (package-file initrd "initrd"
                                                #:system system)))
        ;; XXX: Assume that INITRD is a directory containing an 'initrd' file.
        (return (format #f "menuentry ~s {
  linux ~a ~a
  initrd ~a

R gnu/packages/linux-initrd.scm => gnu/system/linux-initrd.scm +26 -77
@@ 16,22 16,18 @@
;;; 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 linux-initrd)
(define-module (gnu system linux-initrd)
  #:use-module (guix monads)
  #:use-module (guix utils)
  #:use-module (guix licenses)
  #:use-module (guix build-system)
  #:use-module ((guix derivations)
                #:select (imported-modules compiled-modules %guile-for-build))
  #:use-module (gnu packages)
  #:use-module (gnu packages cpio)
  #:use-module (gnu packages compression)
  #:use-module (gnu packages linux)
  #:use-module (gnu packages guile)
  #:use-module ((gnu packages make-bootstrap)
                #:select (%guile-static-stripped))
  #:use-module (guix packages)
  #:use-module (guix download)
  #:use-module (guix build-system trivial))
  #:export (expression->initrd
            qemu-initrd
            gnu-system-initrd))


;;; Commentary:


@@ 42,49 38,6 @@
;;; Code:


(define-syntax-rule (raw-build-system (store system name inputs) body ...)
  "Lift BODY to a package build system."
  ;; TODO: Generalize.
  (build-system
   (name "raw")
   (description "Raw build system")
   (build (lambda* (store name source inputs #:key system #:allow-other-keys)
            (parameterize ((%guile-for-build (package-derivation store
                                                                 guile-2.0)))
              body ...)))))

(define (module-package modules)
  "Return a package that contains all of MODULES, a list of Guile module
names."
  (package
    (name "guile-modules")
    (version "0")
    (source #f)
    (build-system (raw-build-system (store system name inputs)
                    (imported-modules store modules
                                      #:name name
                                      #:system system)))
    (synopsis "Set of Guile modules")
    (description synopsis)
    (license gpl3+)
    (home-page "http://www.gnu.org/software/guix/")))

(define (compiled-module-package modules)
  "Return a package that contains the .go files corresponding to MODULES, a
list of Guile module names."
  (package
    (name "guile-compiled-modules")
    (version "0")
    (source #f)
    (build-system (raw-build-system (store system name inputs)
                    (compiled-modules store modules
                                      #:name name
                                      #:system system)))
    (synopsis "Set of compiled Guile modules")
    (description synopsis)
    (license gpl3+)
    (home-page "http://www.gnu.org/software/guix/")))

(define* (expression->initrd exp
                             #:key
                             (guile %guile-static-stripped)


@@ 212,29 165,25 @@ list of Guile module names to be embedded in the initrd."
                    (and (zero? (system* gzip "--best" "initrd"))
                         (rename-file "initrd.gz" "initrd")))))))))

  (package
    (name name)
    (version "0")
    (source #f)
    (build-system trivial-build-system)
    (arguments `(#:modules ((guix build utils))
                           #:builder ,builder))
    (inputs `(("guile" ,guile)
              ("cpio" ,cpio)
              ("gzip" ,gzip)
              ("modules" ,(module-package modules))
              ("modules/compiled" ,(compiled-module-package modules))
              ,@(if linux
                    `(("linux" ,linux))
                    '())))
    (synopsis "An initial RAM disk (initrd) for the Linux kernel")
    (description
     "An initial RAM disk (initrd), really a gzipped cpio archive, for use by
the Linux kernel.")
    (license gpl3+)
    (home-page "http://www.gnu.org/software/guix/")))

(define-public qemu-initrd
  (mlet* %store-monad
      ((source   (imported-modules modules))
       (compiled (compiled-modules modules))
       (inputs   (lower-inputs
                  `(("guile" ,guile)
                    ("cpio" ,cpio)
                    ("gzip" ,gzip)
                    ("modules" ,source)
                    ("modules/compiled" ,compiled)
                    ,@(if linux
                          `(("linux" ,linux))
                          '())))))
   (derivation-expression name builder
                          #:modules '((guix build utils))
                          #:inputs inputs)))

(define (qemu-initrd)
  "Return a monadic derivation that builds an initrd for use in a QEMU guest
where the store is shared with the host."
  (expression->initrd
   '(begin
      (use-modules (srfi srfi-1)


@@ 339,8 288,8 @@ the Linux kernel.")
   #:linux linux-libre
   #:linux-modules '("cifs.ko" "md4.ko" "ecb.ko")))

(define-public gnu-system-initrd
  ;; Initrd for the GNU system itself, with nothing QEMU-specific.
(define (gnu-system-initrd)
  "Initrd for the GNU system itself, with nothing QEMU-specific."
  (expression->initrd
   '(begin
      (use-modules (srfi srfi-1)

M gnu/system/vm.scm => gnu/system/vm.scm +10 -7
@@ 1,5 1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;


@@ 35,7 35,6 @@
  #:use-module (gnu packages zile)
  #:use-module (gnu packages grub)
  #:use-module (gnu packages linux)
  #:use-module (gnu packages linux-initrd)
  #:use-module (gnu packages package-management)
  #:use-module ((gnu packages make-bootstrap)
                #:select (%guile-static-stripped))


@@ 43,6 42,7 @@

  #:use-module (gnu system shadow)
  #:use-module (gnu system linux)
  #:use-module (gnu system linux-initrd)
  #:use-module (gnu system grub)
  #:use-module (gnu system dmd)
  #:use-module (gnu system)


@@ 67,7 67,7 @@
                                             (system (%current-system))
                                             (inputs '())
                                             (linux linux-libre)
                                             (initrd qemu-initrd)
                                             initrd
                                             (qemu qemu/smb-shares)
                                             (env-vars '())
                                             (modules '())


@@ 78,10 78,10 @@
                                             (references-graphs #f)
                                             (disk-image-size
                                              (* 100 (expt 2 20))))
  "Evaluate EXP in a QEMU virtual machine running LINUX with INITRD.  In the
virtual machine, EXP has access to all of INPUTS from the store; it should put
its output files in the `/xchg' directory, which is copied to the derivation's
output when the VM terminates.
  "Evaluate EXP in a QEMU virtual machine running LINUX with INITRD (a
derivation).  In the virtual machine, EXP has access to all of INPUTS from the
store; it should put its output files in the `/xchg' directory, which is
copied to the derivation's output when the VM terminates.

When MAKE-DISK-IMAGE? is true, then create a QEMU disk image of
DISK-IMAGE-SIZE bytes and return it.


@@ 178,6 178,9 @@ made available under the /xchg CIFS share."
       (user-builder (text-file "builder-in-linux-vm"
                                (object->string exp*)))
       (coreutils -> (car (assoc-ref %final-inputs "coreutils")))
       (initrd       (if initrd
                         (return initrd)
                         (qemu-initrd)))          ; default initrd
       (inputs       (lower-inputs `(("qemu" ,qemu)
                                     ("linux" ,linux)
                                     ("initrd" ,initrd)