;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019 Meiyo Peng <meiyo.peng@gmail.com>
+;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org>
;;;
;;; This file is part of GNU Guix.
;;;
operating-system-user-accounts
operating-system-shepherd-service-names
operating-system-user-kernel-arguments
+ operating-system-firmware
+ operating-system-keyboard-layout
+ operating-system-name-service-switch
+ operating-system-pam-services
+ operating-system-setuid-programs
+ operating-system-skeletons
+ operating-system-sudoers-file
+ operating-system-swap-devices
+ operating-system-kernel-loadable-modules
operating-system-derivation
operating-system-profile
system-linux-image-file-name
operating-system-with-gc-roots
+ operating-system-with-provenance
boot-parameters
boot-parameters?
boot-parameters-label
boot-parameters-root-device
boot-parameters-bootloader-name
+ boot-parameters-bootloader-menu-entries
boot-parameters-store-device
boot-parameters-store-mount-point
boot-parameters-kernel
local-host-aliases
%root-account
%setuid-programs
+ %sudoers-specification
%base-packages
%base-firmware))
(define (bootable-kernel-arguments system root-device)
"Return a list of kernel arguments (gexps) to boot SYSTEM from ROOT-DEVICE."
(list (string-append "--root="
- (cond ((uuid? root-device)
-
- ;; Note: Always use the DCE format because that's
- ;; what (gnu build linux-boot) expects for the
- ;; '--root' kernel command-line option.
- (uuid->string (uuid-bytevector root-device)
- 'dce))
- ((file-system-label? root-device)
- (file-system-label->string root-device))
- (else root-device)))
+ ;; Note: Always use the DCE format because that's what
+ ;; (gnu build linux-boot) expects for the '--root'
+ ;; kernel command-line option.
+ (file-system-device->string root-device
+ #:uuid-type 'dce))
#~(string-append "--system=" #$system)
#~(string-append "--load=" #$system "/boot")))
(kernel operating-system-kernel ; package
(default linux-libre))
+ (kernel-loadable-modules operating-system-kernel-loadable-modules
+ (default '())) ; list of packages
(kernel-arguments operating-system-user-kernel-arguments
(default '("quiet"))) ; list of gexps/strings
(bootloader operating-system-bootloader) ; <bootloader-configuration>
;; OS's root file system, so it might be a device path like "/dev/sda3".
(root-device boot-parameters-root-device)
(bootloader-name boot-parameters-bootloader-name)
+ (bootloader-menu-entries ;list of <menu-entry>
+ boot-parameters-bootloader-menu-entries)
(store-device boot-parameters-store-device)
(store-mount-point boot-parameters-store-mount-point)
(kernel boot-parameters-kernel)
((_ args) args)
(#f 'grub))) ; for compatibility reasons.
+ (bootloader-menu-entries
+ (match (assq 'bootloader-menu-entries rest)
+ ((_ entries) (map sexp->menu-entry entries))
+ (#f '())))
+
;; In the past, we would store the directory name of the kernel instead
;; of the absolute file name of its image. Detect that and correct it.
(kernel (if (string=? linux (direct-store-path linux))
"Return the list of swap services for OS."
(map swap-service (operating-system-swap-devices os)))
-(define* (system-linux-image-file-name #:optional (system (%current-system)))
+(define* (system-linux-image-file-name)
"Return the basename of the kernel image file for SYSTEM."
;; FIXME: Evaluate the conditional based on the actual current system.
- (cond
- ((string-prefix? "arm" (%current-system)) "zImage")
- ((string-prefix? "mips" (%current-system)) "vmlinuz")
- ((string-prefix? "aarch64" (%current-system)) "Image")
- (else "bzImage")))
+ (let ((target (or (%current-target-system) (%current-system))))
+ (cond
+ ((string-prefix? "arm" target) "zImage")
+ ((string-prefix? "mips" target) "vmlinuz")
+ ((string-prefix? "aarch64" target) "Image")
+ (else "bzImage"))))
(define (operating-system-kernel-file os)
"Return an object representing the absolute file name of the kernel image of
OS."
(file-append (operating-system-kernel os)
- "/" (system-linux-image-file-name os)))
+ "/" (system-linux-image-file-name)))
(define* (operating-system-directory-base-entries os)
"Return the basic entries of the 'system' directory of OS for use as the
value of the SYSTEM-SERVICE-TYPE service."
(let ((locale (operating-system-locale-directory os)))
- (mlet %store-monad ((kernel -> (operating-system-kernel os))
- (initrd -> (operating-system-initrd-file os))
- (params (operating-system-boot-parameters-file os)))
+ (mlet* %store-monad ((kernel -> (operating-system-kernel os))
+ (modules ->
+ (operating-system-kernel-loadable-modules os))
+ (kernel
+ (profile-derivation
+ (packages->manifest
+ (cons kernel modules))
+ #:hooks (list linux-module-database)))
+ (initrd -> (operating-system-initrd-file os))
+ (params (operating-system-boot-parameters-file os)))
(return `(("kernel" ,kernel)
("parameters" ,params)
("initrd" ,initrd)
gc-root-service-type roots)
(operating-system-user-services os)))))
+(define* (operating-system-with-provenance os #:optional config-file)
+ "Return a variant of OS that stores its own provenance information,
+including CONFIG-FILE, if available. This is achieved by adding an instance
+of PROVENANCE-SERVICE-TYPE to its services."
+ (operating-system
+ (inherit os)
+ (services (cons (service provenance-service-type config-file)
+ (operating-system-user-services os)))))
+
\f
;;;
;;; /etc.
;; required for basic administrator tasks.
(cons* procps psmisc which less zile nano
pciutils usbutils
- util-linux
+ util-linux+udev
inetutils isc-dhcp
(@ (gnu packages admin) shadow) ;for 'passwd'
iw wireless-tools
iproute
- net-tools ; XXX: remove when Inetutils suffices
man-db
info-reader ;the standalone Info reader (no Perl)
;; to certain networks. Some discussion at
;; https://lists.gnu.org/archive/html/help-guix/2017-09/msg00037.html
("hostname" ,(plain-file "hostname" (operating-system-host-name os)))
+ ;; Some programs (e.g., GLib) look at /etc/timezone to find the
+ ;; name of the current timezone. For details, see
+ ;; https://lists.gnu.org/archive/html/guix-devel/2019-07/msg00166.html
+ ("timezone" ,(plain-file "timezone" (operating-system-timezone os)))
("localtime" ,(file-append tzdata "/share/zoneinfo/"
(operating-system-timezone os)))
("sudoers" ,(operating-system-sudoers-file os))))))
(file-append inetutils "/bin/ping6")
(file-append sudo "/bin/sudo")
(file-append sudo "/bin/sudoedit")
- (file-append fuse "/bin/fusermount"))))
+ (file-append fuse "/bin/fusermount")
+
+ ;; To allow mounts with the "user" option, "mount" and "umount" must
+ ;; be setuid-root.
+ (file-append util-linux "/bin/mount")
+ (file-append util-linux "/bin/umount"))))
(define %sudoers-specification
;; Default /etc/sudoers contents: 'root' and all members of the 'wheel'
(operating-system-user-kernel-arguments os)))
(initrd initrd)
(bootloader-name bootloader-name)
+ (bootloader-menu-entries
+ (bootloader-configuration-menu-entries (operating-system-bootloader os)))
(store-device (ensure-not-/dev (file-system-device store)))
(store-mount-point (file-system-mount-point store)))))
#$(boot-parameters-kernel-arguments params))
(initrd #$(boot-parameters-initrd params))
(bootloader-name #$(boot-parameters-bootloader-name params))
+ (bootloader-menu-entries
+ #$(map menu-entry->sexp
+ (or (and=> (operating-system-bootloader os)
+ bootloader-configuration-menu-entries)
+ '())))
(store
(device
#$(device->sexp (boot-parameters-store-device params)))
HCoop / jackhill / guix / guix.git / blobdiff