;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com>
;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2019 Meiyo Peng <meiyo.peng@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
#:use-module (gnu packages base)
#:use-module (gnu packages bash)
#:use-module (gnu packages guile)
+ #:use-module (gnu packages guile-xyz)
#:use-module (gnu packages admin)
#:use-module (gnu packages linux)
#:use-module (gnu packages pciutils)
#:use-module (rnrs bytevectors)
#:export (operating-system
operating-system?
+ this-operating-system
operating-system-bootloader
operating-system-services
+ operating-system-essential-services
+ operating-system-default-essential-services
operating-system-user-services
operating-system-packages
operating-system-host-name
operating-system-kernel
operating-system-kernel-file
operating-system-kernel-arguments
+ operating-system-label
+ operating-system-default-label
operating-system-initrd-modules
operating-system-initrd
operating-system-users
operating-system-boot-script
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
boot-parameters->menu-entry
local-host-aliases
+ %root-account
%setuid-programs
%base-packages
%base-firmware))
(define-record-type* <operating-system> operating-system
make-operating-system
operating-system?
+ this-operating-system
+
(kernel operating-system-kernel ; package
(default linux-libre))
(kernel-arguments operating-system-user-kernel-arguments
- (default '())) ; list of gexps/strings
+ (default '("quiet"))) ; list of gexps/strings
(bootloader operating-system-bootloader) ; <bootloader-configuration>
+ (label operating-system-label ; string
+ (thunked)
+ (default (operating-system-default-label this-operating-system)))
+ (keyboard-layout operating-system-keyboard-layout ;#f | <keyboard-layout>
+ (default #f))
(initrd operating-system-initrd ; (list fs) -> file-like
(default base-initrd))
(initrd-modules operating-system-initrd-modules ; list of strings
(groups operating-system-groups ; list of user groups
(default %base-groups))
- (skeletons operating-system-skeletons ; list of name/monadic value
+ (skeletons operating-system-skeletons ; list of name/file-like value
(default (default-skeletons)))
(issue operating-system-issue ; string
(default %default-issue))
(name-service-switch operating-system-name-service-switch ; <name-service-switch>
(default %default-nss))
- (services operating-system-user-services ; list of monadic services
+ (essential-services operating-system-essential-services ; list of services
+ (thunked)
+ (default (operating-system-default-essential-services
+ this-operating-system)))
+ (services operating-system-user-services ; list of services
(default %base-services))
(pam-services operating-system-pam-services ; list of PAM services
;; 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 #:key container?)
+(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)))
- (with-monad %store-monad
- (if container?
- (return `(("locale" ,locale)))
- (mlet %store-monad
- ((kernel -> (operating-system-kernel os))
- (initrd -> (operating-system-initrd-file os))
- (params (operating-system-boot-parameters-file os)))
- (return `(("kernel" ,kernel)
- ("parameters" ,params)
- ("initrd" ,initrd)
- ("locale" ,locale)))))))) ;used by libc
-
-(define* (essential-services os #:key container?)
+ (mlet %store-monad ((kernel -> (operating-system-kernel os))
+ (initrd -> (operating-system-initrd-file os))
+ (params (operating-system-boot-parameters-file os)))
+ (return `(("kernel" ,kernel)
+ ("parameters" ,params)
+ ("initrd" ,initrd)
+ ("locale" ,locale)))))) ;used by libc
+
+(define (operating-system-default-essential-services os)
"Return the list of essential services for OS. These are special services
that implement part of what's declared in OS are responsible for low-level
-bookkeeping. CONTAINER? determines whether to return the list of services for
-a container or that of a \"bare metal\" system."
+bookkeeping."
(define known-fs
(map file-system-mount-point (operating-system-file-systems os)))
(swaps (swap-services os))
(procs (service user-processes-service-type))
(host-name (host-name-service (operating-system-host-name os)))
- (entries (operating-system-directory-base-entries
- os #:container? container?)))
+ (entries (operating-system-directory-base-entries os)))
(cons* (service system-service-type entries)
%boot-service
(operating-system-groups os))
(operating-system-skeletons os))
(operating-system-etc-service os)
- (service fstab-service-type '())
+ (service fstab-service-type
+ (filter file-system-needed-for-boot?
+ (operating-system-file-systems os)))
(session-environment-service
(operating-system-environment-variables os))
host-name procs root-fs
other-fs
(append mappings swaps
- ;; Add the firmware service, unless we are building for a
- ;; container.
- (if container?
- (list %containerized-shepherd-service)
- (list %linux-bare-metal-service
- (service firmware-service-type
- (operating-system-firmware os))))))))
-
-(define* (operating-system-services os #:key container?)
- "Return all the services of OS, including \"internal\" services that do not
-explicitly appear in OS."
+ ;; Add the firmware service.
+ (list %linux-bare-metal-service
+ (service firmware-service-type
+ (operating-system-firmware os)))))))
+
+(define* (operating-system-services os)
+ "Return all the services of OS, including \"essential\" services."
(instantiate-missing-services
(append (operating-system-user-services os)
- (essential-services os #:container? container?))))
+ (operating-system-essential-services os))))
+
+(define (operating-system-with-gc-roots os roots)
+ "Return a variant of OS where ROOTS are registered as GC roots."
+ (operating-system
+ (inherit os)
+
+ ;; We use this procedure for the installation OS, which already defines GC
+ ;; roots. Add ROOTS to those.
+ (services (cons (simple-service 'extra-root
+ 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
;;;
;; 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)
;; variant propagated by 'guile-final' and the GMP variant propagated
;; by 'gnutls', itself propagated by 'guix'.
guile-2.2
+ guile-readline guile-colorized
;; The packages below are also in %FINAL-INPUTS, so take them from
;; there to avoid duplication.
;; 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/ping")
(file-append inetutils "/bin/ping6")
(file-append sudo "/bin/sudo")
- (file-append fuse "/bin/fusermount"))))
+ (file-append sudo "/bin/sudoedit")
+ (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'
root ALL=(ALL) ALL
%wheel ALL=(ALL) ALL\n"))
-(define* (operating-system-activation-script os #:key container?)
+(define* (operating-system-activation-script os)
"Return the activation script for OS---i.e., the code that \"activates\" the
stateful part of OS, including user accounts and groups, special directories,
etc."
- (let* ((services (operating-system-services os #:container? container?))
+ (let* ((services (operating-system-services os))
(activation (fold-services services
#:target-type activation-service-type)))
(activation-service->script activation)))
-(define* (operating-system-boot-script os #:key container?)
+(define* (operating-system-boot-script os)
"Return the boot script for OS---i.e., the code started by the initrd once
-we're running in the final root. When CONTAINER? is true, skip all
-hardware-related operations as necessary when booting a Linux container."
- (let* ((services (operating-system-services os #:container? container?))
+we're running in the final root."
+ (let* ((services (operating-system-services os))
(boot (fold-services services #:target-type boot-service-type)))
(service-value boot)))
#:target-type
shepherd-root-service-type))))
-(define* (operating-system-derivation os #:key container?)
+(define* (operating-system-derivation os)
"Return a derivation that builds OS."
- (let* ((services (operating-system-services os #:container? container?))
+ (let* ((services (operating-system-services os))
(system (fold-services services)))
;; SYSTEM contains the derivation as a monadic value.
(service-value system)))
-(define* (operating-system-profile os #:key container?)
+(define* (operating-system-profile os)
"Return a derivation that builds the system profile of OS."
(mlet* %store-monad
- ((services -> (operating-system-services os #:container? container?))
+ ((services -> (operating-system-services os))
(profile (fold-services services
#:target-type profile-service-type)))
(match profile
#:linux (operating-system-kernel os)
#:linux-modules
(operating-system-initrd-modules os)
- #:mapped-devices mapped-devices))
+ #:mapped-devices mapped-devices
+ #:keyboard-layout (operating-system-keyboard-layout os)))
(define (locale-name->definition* name)
"Variant of 'locale-name->definition' that raises an error upon failure."
(cond ((package? kernel)
(string-append "GNU with "
(string-titlecase (package-name kernel)) " "
- (package-version kernel)
- " (beta)"))
+ (package-version kernel)))
((inferior-package? kernel)
(string-append "GNU with "
(string-titlecase (inferior-package-name kernel)) " "
- (inferior-package-version kernel)
- " (beta)"))
+ (inferior-package-version kernel)))
(else "GNU")))
+(define (operating-system-default-label os)
+ "Return the default label for OS, as it will appear in the bootloader menu
+entry."
+ (kernel->boot-label (operating-system-kernel os)))
+
(define (store-file-system file-systems)
"Return the file system object among FILE-SYSTEMS that contains the store."
(match (filter (lambda (fs)
(bootloader (bootloader-configuration-bootloader
(operating-system-bootloader os)))
(bootloader-name (bootloader-name bootloader))
- (label (kernel->boot-label (operating-system-kernel os))))
+ (label (operating-system-label os)))
(boot-parameters
(label label)
(root-device root-device)
(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