;;; 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.
;;;
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu system)
+ #:use-module (guix inferior)
#:use-module (guix store)
#:use-module (guix monads)
#:use-module (guix gexp)
#: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
boot-parameters
boot-parameters?
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
(file-append (operating-system-kernel os)
"/" (system-linux-image-file-name os)))
-(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)))))
\f
;;;
;; 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.
(file-append inetutils "/bin/ping")
(file-append inetutils "/bin/ping6")
(file-append sudo "/bin/sudo")
+ (file-append sudo "/bin/sudoedit")
(file-append fuse "/bin/fusermount"))))
(define %sudoers-specification
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."
(define (kernel->boot-label kernel)
"Return a label for the bootloader menu entry that boots KERNEL."
- (string-append "GNU with "
- (string-titlecase (package-name kernel)) " "
- (package-version kernel)
- " (beta)"))
+ (cond ((package? kernel)
+ (string-append "GNU with "
+ (string-titlecase (package-name kernel)) " "
+ (package-version kernel)))
+ ((inferior-package? kernel)
+ (string-append "GNU with "
+ (string-titlecase (inferior-package-name kernel)) " "
+ (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."
(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)
HCoop / jackhill / guix / guix.git / blobdiff