diff options
Diffstat (limited to 'gnu/system')
| -rw-r--r-- | gnu/system/file-systems.scm | 72 | ||||
| -rw-r--r-- | gnu/system/grub.scm | 84 | ||||
| -rw-r--r-- | gnu/system/linux-initrd.scm | 347 | ||||
| -rw-r--r-- | gnu/system/linux.scm | 89 | ||||
| -rw-r--r-- | gnu/system/shadow.scm | 117 | ||||
| -rw-r--r-- | gnu/system/vm.scm | 478 |
6 files changed, 667 insertions, 520 deletions
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm new file mode 100644 index 0000000000..485150ea51 --- /dev/null +++ b/gnu/system/file-systems.scm @@ -0,0 +1,72 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013, 2014 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 file-systems) + #:use-module (guix records) + #:export (<file-system> + file-system + file-system? + file-system-device + file-system-mount-point + file-system-type + file-system-needed-for-boot? + file-system-flags + file-system-options + + %fuse-control-file-system + %binary-format-file-system)) + +;;; Commentary: +;;; +;;; Declaring file systems to be mounted. +;;; +;;; Code: + +;; File system declaration. +(define-record-type* <file-system> file-system + make-file-system + file-system? + (device file-system-device) ; string + (mount-point file-system-mount-point) ; string + (type file-system-type) ; string + (flags file-system-flags ; list of symbols + (default '())) + (options file-system-options ; string or #f + (default #f)) + (needed-for-boot? file-system-needed-for-boot? ; Boolean + (default #f)) + (check? file-system-check? ; Boolean + (default #t))) + +(define %fuse-control-file-system + ;; Control file system for Linux' file systems in user-space (FUSE). + (file-system + (device "fusectl") + (mount-point "/sys/fs/fuse/connections") + (type "fusectl") + (check? #f))) + +(define %binary-format-file-system + ;; Support for arbitrary executable binary format. + (file-system + (device "binfmt_misc") + (mount-point "/proc/sys/fs/binfmt_misc") + (type "binfmt_misc") + (check? #f))) + +;;; file-systems.scm ends here diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm index 5dc0b85ff2..e789e4c591 100644 --- a/gnu/system/grub.scm +++ b/gnu/system/grub.scm @@ -22,10 +22,16 @@ #:use-module (guix derivations) #:use-module (guix records) #:use-module (guix monads) + #:use-module (guix gexp) #:use-module (ice-9 match) #:use-module (srfi srfi-1) - #:export (menu-entry + #:export (grub-configuration + grub-configuration? + grub-configuration-device + + menu-entry menu-entry? + grub-configuration-file)) ;;; Commentary: @@ -34,51 +40,61 @@ ;;; ;;; Code: +(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 1)) + (timeout grub-configuration-timeout ; integer + (default 5))) + (define-record-type* <menu-entry> menu-entry make-menu-entry menu-entry? (label menu-entry-label) (linux menu-entry-linux) (linux-arguments menu-entry-linux-arguments - (default '())) - (initrd menu-entry-initrd)) ; file name of the initrd + (default '())) ; list of string-valued gexps + (initrd menu-entry-initrd)) ; file name of the initrd as a gexp -(define* (grub-configuration-file entries - #:key (default-entry 1) (timeout 5) - (system (%current-system))) - "Return the GRUB configuration file for ENTRIES, a list of -<menu-entry> objects, defaulting to DEFAULT-ENTRY and with the given TIMEOUT." - (define (prologue kernel) - (format #f " -set default=~a -set timeout=~a -search.file ~a~%" - default-entry timeout kernel)) - - (define (bzImage) - (any (match-lambda - (($ <menu-entry> _ linux) - (package-file linux "bzImage" - #:system system))) - entries)) +(define* (grub-configuration-file config entries + #:key (system (%current-system))) + "Return the GRUB configuration file corresponding to CONFIG, a +<grub-configuration> object." + (define all-entries + (append entries (grub-configuration-menu-entries config))) - (define entry->text + (define entry->gexp (match-lambda (($ <menu-entry> label linux arguments initrd) - (mlet %store-monad ((linux (package-file linux "bzImage" - #:system system))) - (return (format #f "menuentry ~s { - linux ~a ~a + #~(format port "menuentry ~s { + linux ~a/bzImage ~a initrd ~a }~%" - label - linux (string-join arguments) initrd)))))) + #$label + #$linux (string-join (list #$@arguments)) + #$initrd)))) + + (define builder + #~(call-with-output-file #$output + (lambda (port) + (format port " +set default=~a +set timeout=~a +search.file ~a/bzImage~%" + #$(grub-configuration-default-entry config) + #$(grub-configuration-timeout config) + #$(any (match-lambda + (($ <menu-entry> _ linux) + linux)) + all-entries)) + #$@(map entry->gexp all-entries)))) - (mlet %store-monad ((kernel (bzImage)) - (body (sequence %store-monad - (map entry->text entries)))) - (text-file "grub.cfg" - (string-append (prologue kernel) - (string-concatenate body))))) + (gexp->derivation "grub.cfg" builder)) ;;; grub.scm ends here diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index 42ca29cb58..b80ff10f1e 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm @@ -18,19 +18,24 @@ (define-module (gnu system linux-initrd) #:use-module (guix monads) + #:use-module (guix gexp) #:use-module (guix utils) #:use-module ((guix store) #:select (%store-prefix)) + #:use-module ((guix derivations) + #:select (derivation->output-path)) #: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 (gnu system file-systems) + #:use-module (ice-9 match) #:use-module (ice-9 regex) + #:use-module (srfi srfi-1) #:export (expression->initrd - qemu-initrd - gnu-system-initrd)) + qemu-initrd)) ;;; Commentary: @@ -49,12 +54,14 @@ (name "guile-initrd") (system (%current-system)) (modules '()) + (to-copy '()) (linux #f) (linux-modules '())) "Return a package that contains a Linux initrd (a gzipped cpio archive) containing GUILE and that evaluates EXP upon booting. LINUX-MODULES is a list -of `.ko' file names to be copied from LINUX into the initrd. MODULES is a -list of Guile module names to be embedded in the initrd." +of `.ko' file names to be copied from LINUX into the initrd. TO-COPY is a +list of additional derivations or packages to copy to the initrd. MODULES is +a list of Guile module names to be embedded in the initrd." ;; General Linux overview in `Documentation/early-userspace/README' and ;; `Documentation/filesystems/ramfs-rootfs-initramfs.txt'. @@ -63,150 +70,157 @@ list of Guile module names to be embedded in the initrd." ;; Return a regexp that matches STR exactly. (string-append "^" (regexp-quote str) "$")) - (define builder - `(begin - (use-modules (guix build utils) - (ice-9 pretty-print) - (ice-9 popen) - (ice-9 match) - (ice-9 ftw) - (srfi srfi-26) - (system base compile) - (rnrs bytevectors) - ((system foreign) #:select (sizeof))) - - (let ((guile (assoc-ref %build-inputs "guile")) - (cpio (string-append (assoc-ref %build-inputs "cpio") - "/bin/cpio")) - (gzip (string-append (assoc-ref %build-inputs "gzip") - "/bin/gzip")) - (modules (assoc-ref %build-inputs "modules")) - (gos (assoc-ref %build-inputs "modules/compiled")) - (scm-dir (string-append "share/guile/" (effective-version))) - (go-dir (format #f ".cache/guile/ccache/~a-~a-~a-~a" - (effective-version) - (if (eq? (native-endianness) (endianness little)) - "LE" - "BE") - (sizeof '*) - (effective-version))) - (out (assoc-ref %outputs "out"))) - (mkdir out) - (mkdir "contents") - (with-directory-excursion "contents" - (copy-recursively guile ".") - (call-with-output-file "init" - (lambda (p) - (format p "#!/bin/guile -ds~%!#~%" guile) - (pretty-print ',exp p))) - (chmod "init" #o555) - (chmod "bin/guile" #o555) - - ;; Copy Guile modules. - (chmod scm-dir #o777) - (copy-recursively modules scm-dir - #:follow-symlinks? #t) - (copy-recursively gos (string-append "lib/guile/" - (effective-version) "/ccache") - #:follow-symlinks? #t) - - ;; Compile `init'. - (mkdir-p go-dir) - (set! %load-path (cons modules %load-path)) - (set! %load-compiled-path (cons gos %load-compiled-path)) - (compile-file "init" - #:opts %auto-compilation-options - #:output-file (string-append go-dir "/init.go")) - - ;; Copy Linux modules. - (let* ((linux (assoc-ref %build-inputs "linux")) - (module-dir (and linux - (string-append linux "/lib/modules")))) - (mkdir "modules") - ,@(map (lambda (module) - `(match (find-files module-dir - ,(string->regexp module)) - ((file) - (format #t "copying '~a'...~%" file) - (copy-file file (string-append "modules/" - ,module))) - (() - (error "module not found" ,module module-dir)) - ((_ ...) - (error "several modules by that name" - ,module module-dir)))) - linux-modules)) - - ;; Reset the timestamps of all the files that will make it in the - ;; initrd. - (for-each (cut utime <> 0 0 0 0) - (find-files "." ".*")) - - (system* cpio "--version") - (let ((pipe (open-pipe* OPEN_WRITE cpio "-o" - "-O" (string-append out "/initrd") - "-H" "newc" "--null"))) - (define print0 - (let ((len (string-length "./"))) - (lambda (file) - (format pipe "~a\0" (string-drop file len))))) - - ;; Note: as per `ramfs-rootfs-initramfs.txt', always add - ;; directory entries before the files that are inside of it: "The - ;; Linux kernel cpio extractor won't create files in a directory - ;; that doesn't exist, so the directory entries must go before - ;; the files that go in those directories." - (file-system-fold (const #t) - (lambda (file stat result) ; leaf - (print0 file)) - (lambda (dir stat result) ; down - (unless (string=? dir ".") - (print0 dir))) - (const #f) ; up - (const #f) ; skip - (const #f) - #f - ".") - - (and (zero? (close-pipe pipe)) - (with-directory-excursion out - (and (zero? (system* gzip "--best" "initrd")) - (rename-file "initrd.gz" "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 #:key + (mlet* %store-monad ((source (imported-modules modules)) + (compiled (compiled-modules modules))) + (define builder + ;; TODO: Move most of this code to (guix build linux-initrd). + #~(begin + (use-modules (guix build utils) + (ice-9 pretty-print) + (ice-9 popen) + (ice-9 match) + (ice-9 ftw) + (srfi srfi-26) + (system base compile) + (rnrs bytevectors) + ((system foreign) #:select (sizeof))) + + (let ((cpio (string-append #$cpio "/bin/cpio")) + (gzip (string-append #$gzip "/bin/gzip")) + (modules #$source) + (gos #$compiled) + (scm-dir (string-append "share/guile/" (effective-version))) + (go-dir (format #f ".cache/guile/ccache/~a-~a-~a-~a" + (effective-version) + (if (eq? (native-endianness) (endianness little)) + "LE" + "BE") + (sizeof '*) + (effective-version)))) + (mkdir #$output) + (mkdir "contents") + (with-directory-excursion "contents" + (copy-recursively #$guile ".") + (call-with-output-file "init" + (lambda (p) + (format p "#!/bin/guile -ds~%!#~%" #$guile) + (pretty-print '#$exp p))) + (chmod "init" #o555) + (chmod "bin/guile" #o555) + + ;; Copy Guile modules. + (chmod scm-dir #o777) + (copy-recursively modules scm-dir + #:follow-symlinks? #t) + (copy-recursively gos (string-append "lib/guile/" + (effective-version) "/ccache") + #:follow-symlinks? #t) + + ;; Compile `init'. + (mkdir-p go-dir) + (set! %load-path (cons modules %load-path)) + (set! %load-compiled-path (cons gos %load-compiled-path)) + (compile-file "init" + #:opts %auto-compilation-options + #:output-file (string-append go-dir "/init.go")) + + ;; Copy Linux modules. + (let* ((linux #$linux) + (module-dir (and linux + (string-append linux "/lib/modules")))) + (mkdir "modules") + #$@(map (lambda (module) + #~(match (find-files module-dir + #$(string->regexp module)) + ((file) + (format #t "copying '~a'...~%" file) + (copy-file file (string-append "modules/" + #$module))) + (() + (error "module not found" #$module module-dir)) + ((_ ...) + (error "several modules by that name" + #$module module-dir)))) + linux-modules)) + + (let ((store #$(string-append "." (%store-prefix))) + (to-copy '#$to-copy)) + (unless (null? to-copy) + (mkdir-p store)) + ;; XXX: Should we do export-references-graph? + (for-each (lambda (input) + (let ((target + (string-append store "/" + (basename input)))) + (copy-recursively input target))) + to-copy)) + + ;; Reset the timestamps of all the files that will make it in the + ;; initrd. + (for-each (cut utime <> 0 0 0 0) + (find-files "." ".*")) + + (system* cpio "--version") + (let ((pipe (open-pipe* OPEN_WRITE cpio "-o" + "-O" (string-append #$output "/initrd") + "-H" "newc" "--null"))) + (define print0 + (let ((len (string-length "./"))) + (lambda (file) + (format pipe "~a\0" (string-drop file len))))) + + ;; Note: as per `ramfs-rootfs-initramfs.txt', always add + ;; directory entries before the files that are inside of it: "The + ;; Linux kernel cpio extractor won't create files in a directory + ;; that doesn't exist, so the directory entries must go before + ;; the files that go in those directories." + (file-system-fold (const #t) + (lambda (file stat result) ; leaf + (print0 file)) + (lambda (dir stat result) ; down + (unless (string=? dir ".") + (print0 dir))) + (const #f) ; up + (const #f) ; skip + (const #f) + #f + ".") + + (and (zero? (close-pipe pipe)) + (with-directory-excursion #$output + (and (zero? (system* gzip "--best" "initrd")) + (rename-file "initrd.gz" "initrd"))))))))) + + (gexp->derivation name builder + #:modules '((guix build utils))))) + +(define (file-system->spec fs) + "Return a list corresponding to file-system FS that can be passed to the +initrd code." + (match fs + (($ <file-system> device mount-point type flags options _ check?) + (list device mount-point type flags options check?)))) + +(define* (qemu-initrd file-systems + #:key guile-modules-in-chroot? - volatile-root? - (mounts `((cifs "/store" ,(%store-prefix)) - (cifs "/xchg" "/xchg")))) + (qemu-networking? #t) + volatile-root?) "Return a monadic derivation that builds an initrd for use in a QEMU guest -where the store is shared with the host. MOUNTS is a list of file systems to -be mounted atop the root file system, where each item has the form: +where the store is shared with the host. FILE-SYSTEMS is a list of +file-systems to be mounted by the initrd, possibly in addition to the root +file system specified on the kernel command line via '--root'. - (FILE-SYSTEM-TYPE SOURCE TARGET) +When QEMU-NETWORKING? is true, set up networking with the standard QEMU +parameters. + +When VOLATILE-ROOT? is true, the root file system is writable but any changes +to it are lost. When GUILE-MODULES-IN-CHROOT? is true, make core Guile modules available in the new root. This is necessary is the file specified as '--load' needs access to these modules (which is the case if it wants to even just print an -exception and backtrace!). - -When VOLATILE-ROOT? is true, the root file system is writable but any changes -to it are lost." +exception and backtrace!)." (define cifs-modules ;; Modules needed to mount CIFS file systems. '("md4.ko" "ecb.ko" "cifs.ko")) @@ -215,35 +229,56 @@ to it are lost." ;; Modules for the 9p paravirtualized file system. '("9pnet.ko" "9p.ko" "9pnet_virtio.ko")) + (define (file-system-type-predicate type) + (lambda (fs) + (string=? (file-system-type fs) type))) + (define linux-modules ;; Modules added to the initrd and loaded from the initrd. `("virtio.ko" "virtio_ring.ko" "virtio_pci.ko" "virtio_balloon.ko" "virtio_blk.ko" "virtio_net.ko" - ,@(if (assoc-ref mounts 'cifs) + ,@(if (find (file-system-type-predicate "cifs") file-systems) cifs-modules '()) - ,@(if (assoc-ref mounts '9p) + ,@(if (find (file-system-type-predicate "9p") file-systems) virtio-9p-modules + '()) + ,@(if volatile-root? + '("fuse.ko") + '()))) + + (define helper-packages + ;; Packages to be copied on the initrd. + `(,@(if (find (lambda (fs) + (string-prefix? "ext" (file-system-type fs))) + file-systems) + (list e2fsck/static) + '()) + ,@(if volatile-root? + (list unionfs-fuse/static) '()))) (expression->initrd - `(begin - (use-modules (guix build linux-initrd)) - - (boot-system #:mounts ',mounts - #:linux-modules ',linux-modules - #:qemu-guest-networking? #t - #:guile-modules-in-chroot? ',guile-modules-in-chroot? - #:volatile-root? ',volatile-root?)) + #~(begin + (use-modules (guix build linux-initrd) + (guix build utils) + (srfi srfi-26)) + + (with-output-to-port (%make-void-port "w") + (lambda () + (set-path-environment-variable "PATH" '("bin" "sbin") + '#$helper-packages))) + + (boot-system #:mounts '#$(map file-system->spec file-systems) + #:linux-modules '#$linux-modules + #:qemu-guest-networking? #$qemu-networking? + #:guile-modules-in-chroot? '#$guile-modules-in-chroot? + #:volatile-root? '#$volatile-root?)) #:name "qemu-initrd" #:modules '((guix build utils) (guix build linux-initrd)) + #:to-copy helper-packages #:linux linux-libre #:linux-modules linux-modules)) -(define (gnu-system-initrd) - "Initrd for the GNU system itself, with nothing QEMU-specific." - (qemu-initrd #:guile-modules-in-chroot? #f - #:mounts '())) - ;;; linux-initrd.scm ends here diff --git a/gnu/system/linux.scm b/gnu/system/linux.scm index 65868ce9bf..5440f5852f 100644 --- a/gnu/system/linux.scm +++ b/gnu/system/linux.scm @@ -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. ;;; @@ -21,6 +21,7 @@ #:use-module (guix records) #:use-module (guix derivations) #:use-module (guix monads) + #:use-module (guix gexp) #:use-module (ice-9 match) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) @@ -28,8 +29,8 @@ #:export (pam-service pam-entry pam-services->directory - %pam-other-services - unix-pam-service)) + unix-pam-service + base-pam-services)) ;;; Commentary: ;;; @@ -58,58 +59,56 @@ (define-record-type* <pam-entry> pam-entry make-pam-entry pam-entry? - (control pam-entry-control) ; string - (module pam-entry-module) ; file name - (arguments pam-entry-arguments ; list of strings + (control pam-entry-control) ; string + (module pam-entry-module) ; file name + (arguments pam-entry-arguments ; list of string-valued g-expressions (default '()))) (define (pam-service->configuration service) - "Return the configuration string for SERVICE, to be dumped in -/etc/pam.d/NAME, where NAME is the name of SERVICE." - (define (entry->string type entry) + "Return the derivation building the configuration file for SERVICE, to be +dumped in /etc/pam.d/NAME, where NAME is the name of SERVICE." + (define (entry->gexp type entry) (match entry (($ <pam-entry> control module (arguments ...)) - (string-append type " " - control " " module " " - (string-join arguments) - "\n")))) + #~(format #t "~a ~a ~a ~a~%" + #$type #$control #$module + (string-join (list #$@arguments)))))) (match service (($ <pam-service> name account auth password session) - (string-concatenate - (append (map (cut entry->string "account" <>) account) - (map (cut entry->string "auth" <>) auth) - (map (cut entry->string "password" <>) password) - (map (cut entry->string "session" <>) session)))))) + (define builder + #~(begin + (with-output-to-file #$output + (lambda () + #$@(append (map (cut entry->gexp "account" <>) account) + (map (cut entry->gexp "auth" <>) auth) + (map (cut entry->gexp "password" <>) password) + (map (cut entry->gexp "session" <>) session)) + #t)))) + + (gexp->derivation name builder)))) (define (pam-services->directory services) "Return the derivation to build the configuration directory to be used as /etc/pam.d for SERVICES." (mlet %store-monad ((names -> (map pam-service-name services)) - (files (mapm %store-monad - (match-lambda - ((and service ($ <pam-service> name)) - (let ((config (pam-service->configuration service))) - (text-file (string-append name ".pam") config)))) - - ;; XXX: Eventually, SERVICES may be a list of monadic - ;; values instead of plain values. - (map return services)))) + (files (sequence %store-monad + (map pam-service->configuration + ;; XXX: Eventually, SERVICES may be a list of + ;; monadic values instead of plain values. + services)))) (define builder - '(begin - (use-modules (ice-9 match)) + #~(begin + (use-modules (ice-9 match)) - (let ((out (assoc-ref %outputs "out"))) - (mkdir out) - (for-each (match-lambda - ((name . file) - (symlink file (string-append out "/" name)))) - %build-inputs) - #t))) + (mkdir #$output) + (for-each (match-lambda + ((name file) + (symlink file (string-append #$output "/" name)))) + '#$(zip names files)))) - (derivation-expression "pam.d" builder - #:inputs (zip names files)))) + (gexp->derivation "pam.d" builder))) (define %pam-other-services ;; The "other" PAM configuration, which denies everything (see @@ -149,7 +148,19 @@ should be the name of a file used as the message-of-the-day." (pam-entry (control "optional") (module "pam_motd.so") - (arguments (list (string-append "motd=" motd))))) + (arguments + (list #~(string-append "motd=" #$motd))))) (list unix)))))))) +(define* (base-pam-services #:key allow-empty-passwords?) + "Return the list of basic PAM services everyone would want." + (cons %pam-other-services + (map (cut unix-pam-service <> + #:allow-empty-passwords? allow-empty-passwords?) + '("su" "passwd" "sudo" + "useradd" "userdel" "usermod" + "groupadd" "groupdel" "groupmod" + ;; TODO: Add other Shadow programs? + )))) + ;;; linux.scm ends here diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm index 2a85a20ebb..738816b78f 100644 --- a/gnu/system/shadow.scm +++ b/gnu/system/shadow.scm @@ -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. ;;; @@ -17,25 +17,23 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (gnu system shadow) - #:use-module (guix store) #:use-module (guix records) - #:use-module (guix packages) + #:use-module (guix gexp) #:use-module (guix monads) #:use-module ((gnu packages admin) #:select (shadow)) #:use-module (gnu packages bash) - #:use-module (srfi srfi-1) - #:use-module (ice-9 match) + #:use-module (gnu packages guile-wm) #:export (user-account user-account? user-account-name - user-account-pass + user-account-password user-account-uid - user-account-gid + user-account-group + user-account-supplementary-groups user-account-comment user-account-home-directory user-account-shell - user-account-inputs user-group user-group? @@ -44,9 +42,8 @@ user-group-id user-group-members - passwd-file - group-file - guix-build-accounts)) + default-skeletons + skeleton-directory)) ;;; Commentary: ;;; @@ -58,68 +55,66 @@ user-account make-user-account user-account? (name user-account-name) - (password user-account-pass (default "")) - (uid user-account-uid) - (gid user-account-gid) + (password user-account-password (default #f)) + (uid user-account-uid (default #f)) + (group user-account-group) ; number | string + (supplementary-groups user-account-supplementary-groups + (default '())) ; list of strings (comment user-account-comment (default "")) (home-directory user-account-home-directory) - (shell user-account-shell ; monadic value - (default (package-file bash "bin/bash"))) - (inputs user-account-inputs (default `(("bash" ,bash))))) + (shell user-account-shell ; gexp + (default #~(string-append #$bash "/bin/bash")))) (define-record-type* <user-group> user-group make-user-group user-group? (name user-group-name) (password user-group-password (default #f)) - (id user-group-id) + (id user-group-id (default #f)) (members user-group-members (default '()))) -(define (group-file groups) - "Return a /etc/group file for GROUPS, a list of <user-group> objects." - (define contents - (let loop ((groups groups) - (result '())) - (match groups - ((($ <user-group> name _ gid (users ...)) rest ...) - ;; XXX: Ignore the group password. - (loop rest - (cons (string-append name "::" (number->string gid) - ":" (string-join users ",")) - result))) - (() - (string-join (reverse result) "\n" 'suffix))))) +(define (default-skeletons) + "Return the default skeleton files for /etc/skel. These files are copied by +'useradd' in the home directory of newly created user accounts." + (define copy-guile-wm + #~(begin + (use-modules (guix build utils)) + (copy-file (car (find-files #$guile-wm "wm-init-sample.scm")) + #$output))) - (text-file "group" contents)) + (mlet %store-monad ((bashrc (text-file "bashrc" "\ +# Allow non-login shells such as an xterm to get things right. +test -f /etc/profile && source /etc/profile\n")) + (guile-wm (gexp->derivation "guile-wm" copy-guile-wm + #:modules + '((guix build utils)))) + (xdefaults (text-file "Xdefaults" "\ +XTerm*utf8: always +XTerm*metaSendsEscape: true\n")) + (gdbinit (text-file "gdbinit" "\ +# Tell GDB where to look for separate debugging files. +set debug-file-directory ~/.guix-profile/lib/debug\n"))) + (return `((".bashrc" ,bashrc) + (".Xdefaults" ,xdefaults) + (".guile-wm" ,guile-wm) + (".gdbinit" ,gdbinit))))) -(define* (passwd-file accounts #:key shadow?) - "Return a password file for ACCOUNTS, a list of <user-account> objects. If -SHADOW? is true, then it is a /etc/shadow file, otherwise it is a /etc/passwd -file." - ;; XXX: The resulting file is world-readable, so beware when SHADOW? is #t! - (define (contents) - (with-monad %store-monad - (let loop ((accounts accounts) - (result '())) - (match accounts - ((($ <user-account> name pass uid gid comment home-dir mshell) - rest ...) - (mlet %store-monad ((shell mshell)) - (loop rest - (cons (if shadow? - (string-append name - ":" ; XXX: use (crypt PASS …)? - ":::::::") - (string-append name - ":" "x" - ":" (number->string uid) - ":" (number->string gid) - ":" comment ":" home-dir ":" shell)) - result)))) - (() - (return (string-join (reverse result) "\n" 'suffix))))))) +(define (skeleton-directory skeletons) + "Return a directory containing SKELETONS, a list of name/derivation pairs." + (gexp->derivation "skel" + #~(begin + (use-modules (ice-9 match)) - (mlet %store-monad ((contents (contents))) - (text-file (if shadow? "shadow" "passwd") contents))) + (mkdir #$output) + (chdir #$output) + + ;; Note: copy the skeletons instead of symlinking + ;; them like 'file-union' does, because 'useradd' + ;; would just copy the symlinks as is. + (for-each (match-lambda + ((target source) + (copy-file source target))) + '#$skeletons) + #t))) ;;; shadow.scm ends here diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 069ac3093a..a15c4c358b 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -19,6 +19,7 @@ (define-module (gnu system vm) #:use-module (guix config) #:use-module (guix store) + #:use-module (guix gexp) #:use-module (guix derivations) #:use-module (guix packages) #:use-module (guix monads) @@ -41,6 +42,7 @@ #:use-module (gnu system linux) #:use-module (gnu system linux-initrd) #:use-module (gnu system grub) + #:use-module (gnu system file-systems) #:use-module (gnu system) #:use-module (gnu services) @@ -52,7 +54,8 @@ qemu-image system-qemu-image system-qemu-image/shared-store - system-qemu-image/shared-store-script)) + system-qemu-image/shared-store-script + system-disk-image)) ;;; Commentary: @@ -81,19 +84,34 @@ input tuple. The output file name is when building for SYSTEM." ((input (and (? string?) (? store-path?) file)) (return `(,input . ,file)))))) -;; An alias to circumvent name clashes. -(define %imported-modules imported-modules) +(define %linux-vm-file-systems + ;; File systems mounted for 'derivation-in-linux-vm'. The store and /xchg + ;; directory are shared with the host over 9p. + (list (file-system + (mount-point (%store-prefix)) + (device "store") + (type "9p") + (needed-for-boot? #t) + (options "trans=virtio") + (check? #f)) + (file-system + (mount-point "/xchg") + (device "xchg") + (type "9p") + (needed-for-boot? #t) + (options "trans=virtio") + (check? #f)))) (define* (expression->derivation-in-linux-vm name exp #:key (system (%current-system)) - (inputs '()) (linux linux-libre) initrd (qemu qemu-headless) (env-vars '()) - (imported-modules + (modules '((guix build vm) + (guix build install) (guix build linux-initrd) (guix build utils))) (guile-for-build @@ -102,222 +120,240 @@ input tuple. The output file name is when building for SYSTEM." (make-disk-image? #f) (references-graphs #f) (memory-size 256) + (disk-image-format "qcow2") (disk-image-size (* 100 (expt 2 20)))) "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 +derivation). In the virtual machine, EXP has access to all its 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. The virtual machine runs with MEMORY-SIZE MiB of memory. -When MAKE-DISK-IMAGE? is true, then create a QEMU disk image of -DISK-IMAGE-SIZE bytes and return it. +When MAKE-DISK-IMAGE? is true, then create a QEMU disk image of type +DISK-IMAGE-FORMAT (e.g., 'qcow2' or 'raw'), of DISK-IMAGE-SIZE bytes and +return it. -IMPORTED-MODULES is the set of modules imported in the execution environment -of EXP. +MODULES is the set of modules imported in the execution environment of EXP. When REFERENCES-GRAPHS is true, it must be a list of file name/store path pairs, as for `derivation'. The files containing the reference graphs are made available under the /xchg CIFS share." - ;; FIXME: Add #:modules parameter, for the 'use-modules' form. - - (define input-alist - (map input->name+output inputs)) - - (define builder - ;; Code that launches the VM that evaluates EXP. - `(let () - (use-modules (guix build utils) - (guix build vm)) - - (let ((linux (string-append (assoc-ref %build-inputs "linux") - "/bzImage")) - (initrd (string-append (assoc-ref %build-inputs "initrd") - "/initrd")) - (loader (assoc-ref %build-inputs "loader")) - (graphs ',(match references-graphs - (((graph-files . _) ...) graph-files) - (_ #f)))) - - (set-path-environment-variable "PATH" '("bin") - (map cdr %build-inputs)) - - (load-in-linux-vm loader - #:output (assoc-ref %outputs "out") - #:linux linux #:initrd initrd - #:memory-size ,memory-size - #:make-disk-image? ,make-disk-image? - #:disk-image-size ,disk-image-size - #:references-graphs graphs)))) - (mlet* %store-monad - ((input-alist (sequence %store-monad input-alist)) - (module-dir (%imported-modules imported-modules)) - (compiled (compiled-modules imported-modules)) - (exp* -> `(let ((%build-inputs ',input-alist)) - ,exp)) - (user-builder (text-file "builder-in-linux-vm" - (object->string exp*))) - (loader (text-file* "linux-vm-loader" ; XXX: use 'sexp-file' - "(begin (set! %load-path (cons \"" - module-dir "\" %load-path)) " - "(set! %load-compiled-path (cons \"" - compiled "\" %load-compiled-path))" - "(primitive-load \"" user-builder "\"))")) + ((module-dir (imported-modules modules)) + (compiled (compiled-modules modules)) + (user-builder (gexp->file "builder-in-linux-vm" exp)) + (loader (gexp->file "linux-vm-loader" + #~(begin + (set! %load-path + (cons #$module-dir %load-path)) + (set! %load-compiled-path + (cons #$compiled + %load-compiled-path)) + (primitive-load #$user-builder)))) (coreutils -> (car (assoc-ref %final-inputs "coreutils"))) (initrd (if initrd ; use the default initrd? (return initrd) - (qemu-initrd #:guile-modules-in-chroot? #t - #:mounts `((9p "store" ,(%store-prefix)) - (9p "xchg" "/xchg"))))) - (inputs (lower-inputs `(("qemu" ,qemu) - ("linux" ,linux) - ("initrd" ,initrd) - ("coreutils" ,coreutils) - ("builder" ,user-builder) - ("loader" ,loader) - ,@inputs)))) - (derivation-expression name builder - ;; TODO: Require the "kvm" feature. - #:system system - #:inputs inputs - #:env-vars env-vars - #:modules (delete-duplicates - `((guix build utils) - (guix build vm) - (guix build linux-initrd) - ,@imported-modules)) - #:guile-for-build guile-for-build - #:references-graphs references-graphs))) + (qemu-initrd %linux-vm-file-systems + #:guile-modules-in-chroot? #t)))) + + (define builder + ;; Code that launches the VM that evaluates EXP. + #~(begin + (use-modules (guix build utils) + (guix build vm)) + + (let ((inputs '#$(list qemu coreutils)) + (linux (string-append #$linux "/bzImage")) + (initrd (string-append #$initrd "/initrd")) + (loader #$loader) + (graphs '#$(match references-graphs + (((graph-files . _) ...) graph-files) + (_ #f)))) + + (set-path-environment-variable "PATH" '("bin") inputs) + + (load-in-linux-vm loader + #:output #$output + #:linux linux #:initrd initrd + #:memory-size #$memory-size + #:make-disk-image? #$make-disk-image? + #:disk-image-format #$disk-image-format + #:disk-image-size #$disk-image-size + #:references-graphs graphs)))) + + (gexp->derivation name builder + ;; TODO: Require the "kvm" feature. + #:system system + #:env-vars env-vars + #:modules modules + #:guile-for-build guile-for-build + #:references-graphs references-graphs))) (define* (qemu-image #:key (name "qemu-image") (system (%current-system)) + (qemu qemu-headless) (disk-image-size (* 100 (expt 2 20))) + (disk-image-format "qcow2") + (file-system-type "ext4") grub-configuration - (initialize-store? #f) - (populate #f) + (register-closures? #t) (inputs '()) - (inputs-to-copy '())) - "Return a bootable, stand-alone QEMU image. The returned image is a full -disk image, with a GRUB installation that uses GRUB-CONFIGURATION as its -configuration file (GRUB-CONFIGURATION must be the name of a file in the VM.) - -INPUTS-TO-COPY is a list of inputs (as for packages) whose closure is copied -into the image being built. When INITIALIZE-STORE? is true, initialize the -store database in the image so that Guix can be used in the image. - -POPULATE is a list of directives stating directories or symlinks to be created -in the disk image partition. It is evaluated once the image has been -populated with INPUTS-TO-COPY. It can be used to provide additional files, -such as /etc files." + copy-inputs?) + "Return a bootable, stand-alone QEMU image of type DISK-IMAGE-FORMAT (e.g., +'qcow2' or 'raw'), with a root partition of type FILE-SYSTEM-TYPE. The +returned image is a full disk image, with a GRUB installation that uses +GRUB-CONFIGURATION as its configuration file (GRUB-CONFIGURATION must be the +name of a file in the VM.) + +INPUTS is a list of inputs (as for packages). When COPY-INPUTS? is true, copy +all of INPUTS into the image being built. When REGISTER-CLOSURES? is true, +register INPUTS in the store database of the image so that Guix can be used in +the image." (mlet %store-monad - ((graph (sequence %store-monad - (map input->name+output inputs-to-copy)))) + ((graph (sequence %store-monad (map input->name+output inputs)))) (expression->derivation-in-linux-vm - "qemu-image" - `(let () - (use-modules (guix build vm) - (guix build utils)) - - (set-path-environment-variable "PATH" '("bin" "sbin") - (map cdr %build-inputs)) - - (let ((graphs ',(match inputs-to-copy - (((names . _) ...) - names)))) - (initialize-hard-disk #:grub.cfg ,grub-configuration - #:closures-to-copy graphs - #:disk-image-size ,disk-image-size - #:initialize-store? ,initialize-store? - #:directives ',populate) - (reboot))) + name + #~(begin + (use-modules (guix build vm) + (guix build utils)) + + (let ((inputs + '#$(append (list qemu parted grub e2fsprogs util-linux) + (map (compose car (cut assoc-ref %final-inputs <>)) + '("sed" "grep" "coreutils" "findutils" "gawk")) + (if register-closures? (list guix) '()))) + + ;; This variable is unused but allows us to add INPUTS-TO-COPY + ;; as inputs. + (to-register + '#$(map (match-lambda + ((name thing) thing) + ((name thing output) `(,thing ,output))) + inputs))) + + (set-path-environment-variable "PATH" '("bin" "sbin") inputs) + + (let ((graphs '#$(match inputs + (((names . _) ...) + names)))) + (initialize-hard-disk "/dev/vda" + #:grub.cfg #$grub-configuration + #:closures graphs + #:copy-closures? #$copy-inputs? + #:register-closures? #$register-closures? + #:disk-image-size #$disk-image-size + #:file-system-type #$file-system-type) + (reboot)))) #:system system - #:inputs `(("parted" ,parted) - ("grub" ,grub) - ("e2fsprogs" ,e2fsprogs) - - ;; For shell scripts. - ("sed" ,(car (assoc-ref %final-inputs "sed"))) - ("grep" ,(car (assoc-ref %final-inputs "grep"))) - ("coreutils" ,(car (assoc-ref %final-inputs "coreutils"))) - ("findutils" ,(car (assoc-ref %final-inputs "findutils"))) - ("gawk" ,(car (assoc-ref %final-inputs "gawk"))) - ("util-linux" ,util-linux) - - ,@(if initialize-store? - `(("guix" ,guix)) - '()) - - ,@inputs-to-copy) #:make-disk-image? #t #:disk-image-size disk-image-size + #:disk-image-format disk-image-format #:references-graphs graph))) ;;; -;;; Stand-alone VM image. +;;; VM and disk images. ;;; -(define (operating-system-build-gid os) - "Return as a monadic value the group id for build users of OS, or #f." - (anym %store-monad - (lambda (service) - (and (equal? '(guix-daemon) - (service-provision service)) - (match (service-user-groups service) - ((group) - (user-group-id group))))) - (operating-system-services os))) - -(define (operating-system-default-contents os) - "Return a list of directives suitable for 'system-qemu-image' describing the -basic contents of the root file system of OS." - (define (user-directories user) - (let ((home (user-account-home-directory user)) - ;; XXX: Deal with automatically allocated ids. - (uid (or (user-account-uid user) 0)) - (gid (or (user-account-gid user) 0)) - (root (string-append "/var/guix/profiles/per-user/" - (user-account-name user)))) - `((directory ,root ,uid ,gid) - (directory ,home ,uid ,gid)))) - - (mlet* %store-monad ((os-drv (operating-system-derivation os)) - (os-dir -> (derivation->output-path os-drv)) - (build-gid (operating-system-build-gid os)) - (profile (operating-system-profile-directory os))) - (return `((directory ,(%store-prefix) 0 ,(or build-gid 0)) - (directory "/etc") - (directory "/var/log") ; for dmd - (directory "/var/run/nscd") - (directory "/var/guix/gcroots") - ("/var/guix/gcroots/system" -> ,os-dir) - (directory "/run") - ("/run/current-system" -> ,profile) - (directory "/bin") - ("/bin/sh" -> "/run/current-system/bin/bash") - (directory "/tmp") - (directory "/var/guix/profiles/per-user/root" 0 0) - - (directory "/root" 0 0) ; an exception - ,@(append-map user-directories - (operating-system-users os)))))) +(define* (system-disk-image os + #:key + (file-system-type "ext4") + (disk-image-size (* 900 (expt 2 20))) + (volatile? #t)) + "Return the derivation of a disk image of DISK-IMAGE-SIZE bytes of the +system described by OS. Said image can be copied on a USB stick as is. When +VOLATILE? is true, the root file system is made volatile; this is useful +to USB sticks meant to be read-only." + (define file-systems-to-keep + (remove (lambda (fs) + (string=? (file-system-mount-point fs) "/")) + (operating-system-file-systems os))) + + (let ((os (operating-system (inherit os) + ;; Since this is meant to be used on real hardware, don't set up + ;; QEMU networking. + (initrd (cut qemu-initrd <> + #:volatile-root? volatile? + #:qemu-networking? #f)) + + ;; Force our own root file system. + (file-systems (cons (file-system + (mount-point "/") + (device "/dev/sda1") + (type file-system-type)) + file-systems-to-keep))))) + + (mlet* %store-monad ((os-drv (operating-system-derivation os)) + (grub.cfg (operating-system-grub.cfg os))) + (qemu-image #:grub-configuration grub.cfg + #:disk-image-size disk-image-size + #:disk-image-format "raw" + #:file-system-type file-system-type + #:copy-inputs? #t + #:register-closures? #t + #:inputs `(("system" ,os-drv) + ("grub.cfg" ,grub.cfg)))))) (define* (system-qemu-image os - #:key (disk-image-size (* 900 (expt 2 20)))) - "Return the derivation of a QEMU image of DISK-IMAGE-SIZE bytes of the GNU -system as described by OS." - (mlet* %store-monad - ((os-drv (operating-system-derivation os)) - (os-dir -> (derivation->output-path os-drv)) - (grub.cfg -> (string-append os-dir "/grub.cfg")) - (populate (operating-system-default-contents os))) - (qemu-image #:grub-configuration grub.cfg - #:populate populate - #:disk-image-size disk-image-size - #:initialize-store? #t - #:inputs-to-copy `(("system" ,os-drv))))) + #:key + (file-system-type "ext4") + (disk-image-size (* 900 (expt 2 20)))) + "Return the derivation of a freestanding QEMU image of DISK-IMAGE-SIZE bytes +of the GNU system as described by OS." + (define file-systems-to-keep + ;; Keep only file systems other than root and not normally bound to real + ;; devices. + (remove (lambda (fs) + (let ((target (file-system-mount-point fs)) + (source (file-system-device fs))) + (or (string=? target "/") + (string-prefix? "/dev/" source)))) + (operating-system-file-systems os))) + + (let ((os (operating-system (inherit os) + ;; Force our own root file system. + (file-systems (cons (file-system + (mount-point "/") + (device "/dev/sda1") + (type file-system-type)) + file-systems-to-keep))))) + (mlet* %store-monad + ((os-drv (operating-system-derivation os)) + (grub.cfg (operating-system-grub.cfg os))) + (qemu-image #:grub-configuration grub.cfg + #:disk-image-size disk-image-size + #:file-system-type file-system-type + #:inputs `(("system" ,os-drv) + ("grub.cfg" ,grub.cfg)) + #:copy-inputs? #t)))) + +(define (virtualized-operating-system os) + "Return an operating system based on OS suitable for use in a virtualized +environment with the store shared with the host." + (operating-system (inherit os) + (initrd (cut qemu-initrd <> #:volatile-root? #t)) + (file-systems (cons* (file-system + (mount-point "/") + (device "/dev/vda1") + (type "ext4")) + (file-system + (mount-point (%store-prefix)) + (device "store") + (type "9p") + (needed-for-boot? #t) + (options "trans=virtio") + (check? #f)) + + ;; Remove file systems that conflict with those + ;; above, or that are normally bound to real devices. + (remove (lambda (fs) + (let ((target (file-system-mount-point fs)) + (source (file-system-device fs))) + (or (string=? target (%store-prefix)) + (string=? target "/") + (string-prefix? "/dev/" source)))) + (operating-system-file-systems os)))))) (define* (system-qemu-image/shared-store os @@ -326,13 +362,14 @@ system as described by OS." with the host." (mlet* %store-monad ((os-drv (operating-system-derivation os)) - (os-dir -> (derivation->output-path os-drv)) - (grub.cfg -> (string-append os-dir "/grub.cfg")) - (populate (operating-system-default-contents os))) - ;; TODO: Initialize the database so Guix can be used in the guest. + (grub.cfg (operating-system-grub.cfg os))) (qemu-image #:grub-configuration grub.cfg - #:populate populate - #:disk-image-size disk-image-size))) + #:disk-image-size disk-image-size + #:inputs `(("system" ,os-drv)) + + ;; XXX: Passing #t here is too slow, so let it off by default. + #:register-closures? #f + #:copy-inputs? #f))) (define* (system-qemu-image/shared-store-script os @@ -341,47 +378,28 @@ with the host." (graphic? #t)) "Return a derivation that builds a script to run a virtual machine image of OS that shares its store with the host." - (let* ((initrd (qemu-initrd #:mounts `((9p "store" ,(%store-prefix))) - #:volatile-root? #t)) - (os (operating-system (inherit os) (initrd initrd)))) + (mlet* %store-monad + ((os -> (virtualized-operating-system os)) + (os-drv (operating-system-derivation os)) + (image (system-qemu-image/shared-store os))) (define builder - (mlet %store-monad ((image (system-qemu-image/shared-store os)) - (qemu (package-file qemu - "bin/qemu-system-x86_64")) - (bash (package-file bash "bin/sh")) - (kernel (package-file (operating-system-kernel os) - "bzImage")) - (initrd initrd) - (os-drv (operating-system-derivation os))) - (return `(let ((out (assoc-ref %outputs "out"))) - (call-with-output-file out - (lambda (port) - (display - (string-append "#!" ,bash " -exec " ,qemu " -enable-kvm -no-reboot -net nic,model=virtio \ - -virtfs local,path=" ,(%store-prefix) ",security_model=none,mount_tag=store \ + #~(call-with-output-file #$output + (lambda (port) + (display + (string-append "#!" #$bash "/bin/sh +exec " #$qemu "/bin/qemu-system-x86_64 -enable-kvm -no-reboot -net nic,model=virtio \ + -virtfs local,path=" #$(%store-prefix) ",security_model=none,mount_tag=store \ -net user \ - -kernel " ,kernel " -initrd " - ,(string-append (derivation->output-path initrd) "/initrd") " \ --append \"" ,(if graphic? "" "console=ttyS0 ") -"--load=" ,(derivation->output-path os-drv) "/boot --root=/dev/vda1\" \ - -drive file=" ,(derivation->output-path image) + -kernel " #$(operating-system-kernel os) "/bzImage \ + -initrd " #$os-drv "/initrd \ +-append \"" #$(if graphic? "" "console=ttyS0 ") + "--system=" #$os-drv " --load=" #$os-drv "/boot --root=/dev/vda1\" \ + -serial stdio \ + -drive file=" #$image ",if=virtio,cache=writeback,werror=report,readonly\n") - port))) - (chmod out #o555) - #t)))) - - (mlet %store-monad ((image (system-qemu-image/shared-store os)) - (initrd initrd) - (qemu (package->derivation qemu)) - (bash (package->derivation bash)) - (os (operating-system-derivation os)) - (builder builder)) - (derivation-expression "run-vm.sh" builder - #:inputs `(("qemu" ,qemu) - ("image" ,image) - ("bash" ,bash) - ("initrd" ,initrd) - ("os" ,os)))))) + port) + (chmod port #o555)))) + + (gexp->derivation "run-vm.sh" builder))) ;;; vm.scm ends here |