;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com>
-;;; Copyright © 2015, 2016 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2015, 2016, 2020 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
;;; Copyright © 2016, 2017 Leo Famulari <leo@famulari.name>
;;; Copyright © 2016 David Craven <david@craven.ch>
;;; Copyright © 2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de>
;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
+;;; Copyright © 2021 qblade <qblade@protonmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
#:use-module (gnu services)
#:use-module (gnu services admin)
#:use-module (gnu services shepherd)
+ #:use-module (gnu services sysctl)
#:use-module (gnu system pam)
#:use-module (gnu system shadow) ; 'user-account', etc.
#:use-module (gnu system uuid)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
#:use-module (ice-9 format)
- #:re-export (user-processes-service-type) ;backwards compatibility
+ #:re-export (user-processes-service-type ;backwards compatibility
+ %default-substitute-urls)
#:export (fstab-service-type
root-file-system-service
file-system-service-type
swap-service
host-name-service
- console-keymap-service
%default-console-font
console-font-service-type
console-font-service
agetty-service-type
mingetty-configuration
+ mingetty-configuration-tty
+ mingetty-configuration-auto-login
+ mingetty-configuration-login-program
+ mingetty-configuration-login-pause?
+ mingetty-configuration-clear-on-logout?
+ mingetty-configuration-mingetty
mingetty-configuration?
mingetty-service
mingetty-service-type
guix-configuration-extra-options
guix-configuration-log-file
- guix-service
guix-service-type
guix-publish-configuration
guix-publish-configuration?
guix-publish-configuration-nar-path
guix-publish-configuration-cache
guix-publish-configuration-ttl
- guix-publish-service
guix-publish-service-type
gpm-configuration
gpm-configuration?
gpm-service-type
- gpm-service
urandom-seed-service-type
- urandom-seed-service
rngd-configuration
rngd-configuration?
(define root-file-system-service-type
(shepherd-service-type 'root-file-system
- (const %root-file-system-shepherd-service)))
+ (const %root-file-system-shepherd-service)
+ (description "Take care of syncing the root file
+system and of remounting it read-only when the system shuts down.")))
(define (root-file-system-service)
"Return a service whose sole purpose is to re-mount read-only the root file
(define (mapped-device->shepherd-service-name md)
"Return the symbol that denotes the shepherd service of MD, a <mapped-device>."
(symbol-append 'device-mapping-
- (string->symbol (mapped-device-target md))))
+ (string->symbol (string-join
+ (mapped-device-targets md) "-"))))
(define dependency->shepherd-service-name
(match-lambda
generator (RNG) with the value recorded when the system was last shut
down.")))
-(define-deprecated (urandom-seed-service)
- urandom-seed-service-type
- (service urandom-seed-service-type))
-
;;;
;;; Add hardware random number generator to entropy pool.
(requirement '(udev))
(provision '(trng))
(start #~(make-forkexec-constructor '#$rngd-command))
- (stop #~(make-kill-destructor))))))
+ (stop #~(make-kill-destructor))))
+ (description "Run the @command{rngd} random number generation daemon to
+supply entropy to the kernel's pool.")))
(define* (rngd-service #:key
(rng-tools rng-tools)
(provision '(host-name))
(start #~(lambda _
(sethostname #$name)))
- (one-shot? #t)))))
+ (one-shot? #t)))
+ (description "Initialize the machine's host name.")))
(define (host-name-service name)
"Return a service that sets the host name to @var{name}."
(display 1 port))))
#t))
(stop #~(const #f)))))
- #t)) ;default to UTF-8
+ #t ;default to UTF-8
+ (description "Ensure the Linux virtual terminals run in UTF-8 mode.")))
(define console-keymap-service-type
(shepherd-service-type
(start #~(lambda _
(zero? (system* #$(file-append kbd "/bin/loadkeys")
#$@files))))
- (respawn? #f)))))
-
-(define-deprecated (console-keymap-service #:rest files)
- #f
- "Return a service to load console keymaps from @var{files}."
- (service console-keymap-service-type files))
+ (respawn? #f)))
+ (description "@emph{This service is deprecated in favor of the
+@code{keyboard-layout} field of @code{operating-system}.} Load the given list
+of console keymaps with @command{loadkeys}.")))
(define %default-console-font
;; Note: 'LatGrkCyr-8x16' has the advantage of providing three common
(define-record-type* <mingetty-configuration>
mingetty-configuration make-mingetty-configuration
mingetty-configuration?
- (mingetty mingetty-configuration-mingetty ;<package>
- (default mingetty))
- (tty mingetty-configuration-tty) ;string
- (auto-login mingetty-auto-login ;string | #f
- (default #f))
- (login-program mingetty-login-program ;gexp
- (default #f))
- (login-pause? mingetty-login-pause? ;Boolean
- (default #f)))
+ (mingetty mingetty-configuration-mingetty ;<package>
+ (default mingetty))
+ (tty mingetty-configuration-tty) ;string
+ (auto-login mingetty-auto-login ;string | #f
+ (default #f))
+ (login-program mingetty-login-program ;gexp
+ (default #f))
+ (login-pause? mingetty-login-pause? ;Boolean
+ (default #f))
+ (clear-on-logout? mingetty-clear-on-logout? ;Boolean
+ (default #t)))
(define mingetty-shepherd-service
(match-lambda
(($ <mingetty-configuration> mingetty tty auto-login login-program
- login-pause?)
+ login-pause? clear-on-logout?)
(list
(shepherd-service
(documentation "Run mingetty on an tty.")
(start #~(make-forkexec-constructor
(list #$(file-append mingetty "/sbin/mingetty")
- "--noclear"
;; Avoiding 'vhangup' allows us to avoid 'setfont'
;; errors down the path where various ioctls get
;; in Linux.
"--nohangup" #$tty
+ #$@(if clear-on-logout?
+ #~()
+ #~("--noclear"))
#$@(if auto-login
#~("--autologin" #$auto-login)
#~())
(pid (spawn)))
(umask mask)
pid))))
- (stop #~(make-kill-destructor))))))
+ (stop #~(make-kill-destructor))))
+ (description "Run the syslog daemon, @command{syslogd}, which is
+responsible for logging system messages.")))
;; Snippet adapted from the GNU inetutils manual.
(define %default-syslog.conf
(default 0))
(log-compression guix-configuration-log-compression
(default 'bzip2))
+ (discover? guix-configuration-discover?
+ (default #f))
(extra-options guix-configuration-extra-options ;list of strings
(default '()))
(log-file guix-configuration-log-file ;string
(environ environment)
#t)))))
+(define shepherd-discover-action
+ ;; Shepherd action to enable or disable substitute servers discovery.
+ (shepherd-action
+ (name 'discover)
+ (documentation
+ "Enable or disable substitute servers discovery and restart the
+'guix-daemon'.")
+ (procedure #~(lambda* (_ status)
+ (let ((environment (environ)))
+ (if (and status
+ (string=? status "on"))
+ (begin
+ (format #t "enable substitute servers discovery~%")
+ (setenv "discover" "on"))
+ (begin
+ (format #t "disable substitute servers discovery~%")
+ (unsetenv "discover")))
+ (action 'guix-daemon 'restart)
+ (environ environment)
+ #t)))))
+
(define (guix-shepherd-service config)
"Return a <shepherd-service> for the Guix daemon service with CONFIG."
(match-record config <guix-configuration>
(guix build-group build-accounts authorize-key? authorized-keys
use-substitutes? substitute-urls max-silent-time timeout
- log-compression extra-options log-file http-proxy tmpdir
- chroot-directories)
+ log-compression discover? extra-options log-file
+ http-proxy tmpdir chroot-directories)
(list (shepherd-service
(documentation "Run the Guix daemon.")
(provision '(guix-daemon))
(requirement '(user-processes))
- (actions (list shepherd-set-http-proxy-action))
+ (actions (list shepherd-set-http-proxy-action
+ shepherd-discover-action))
(modules '((srfi srfi-1)
(ice-9 match)
(gnu build shepherd)))
;; the 'set-http-proxy' action.
(or (getenv "http_proxy") #$http-proxy))
+ (define discover?
+ (or (getenv "discover") #$discover?))
+
;; Start the guix-daemon from a container, when supported,
;; to solve an installation issue. See the comment below for
;; more details.
#$@(if use-substitutes?
'()
'("--no-substitutes"))
+ (string-append "--discover="
+ (if discover? "yes" "no"))
"--substitute-urls" #$(string-join substitute-urls)
#$@extra-options
"Return a file that contains the list of references of ITEM."
(if (struct? item) ;lowerable object
(computed-file name
- (with-imported-modules (source-module-closure
- '((guix build store-copy)))
- #~(begin
- (use-modules (guix build store-copy))
-
- (call-with-output-file #$output
- (lambda (port)
- (write (map store-info-item
- (call-with-input-file "graph"
- read-reference-graph))
- port)))))
+ (with-extensions (list guile-gcrypt) ;for store-copy
+ (with-imported-modules (source-module-closure
+ '((guix build store-copy)))
+ #~(begin
+ (use-modules (guix build store-copy))
+
+ (call-with-output-file #$output
+ (lambda (port)
+ (write (map store-info-item
+ (call-with-input-file "graph"
+ read-reference-graph))
+ port))))))
#:options `(#:local-build? #f
#:references-graphs (("graph" ,item))))
(plain-file name "()")))
(description
"Run the build daemon of GNU@tie{}Guix, aka. @command{guix-daemon}.")))
-(define-deprecated (guix-service #:optional
- (config %default-guix-configuration))
- guix-service-type
- "Return a service that runs the Guix build daemon according to
-@var{config}."
- (service guix-service-type config))
-
(define-record-type* <guix-publish-configuration>
guix-publish-configuration make-guix-publish-configuration
(default 80))
(host guix-publish-configuration-host ;string
(default "localhost"))
+ (advertise? guix-publish-advertise? ;boolean
+ (default #f))
(compression guix-publish-configuration-compression
(thunked)
(default (default-compression this-record
raise a deprecation warning if the 'compression-level' field was used."
(match (%guix-publish-configuration-compression-level config)
(#f
- '(("gzip" 3)))
+ ;; Default to low compression levels when there's no cache so that users
+ ;; get good bandwidth by default.
+ (if (guix-publish-configuration-cache config)
+ '(("gzip" 5) ("zstd" 19))
+ '(("gzip" 3) ("zstd" 3)))) ;zstd compresses faster
(level
(warn-about-deprecation 'compression-level properties
#:replacement 'compression)
lst))))
(match-record config <guix-publish-configuration>
- (guix port host nar-path cache workers ttl cache-bypass-threshold)
+ (guix port host nar-path cache workers ttl cache-bypass-threshold
+ advertise?)
(list (shepherd-service
(provision '(guix-publish))
- (requirement '(guix-daemon))
+ (requirement `(user-processes
+ guix-daemon
+ ,@(if advertise? '(avahi-daemon) '())))
(start #~(make-forkexec-constructor
(list #$(file-append guix "/bin/guix")
"publish" "-u" "guix-publish"
#$@(config->compression-options config)
(string-append "--nar-path=" #$nar-path)
(string-append "--listen=" #$host)
+ #$@(if advertise?
+ #~("--advertise")
+ #~())
#$@(if workers
#~((string-append "--workers="
#$(number->string
"Add a Shepherd service running @command{guix publish}, a
command that allows you to share pre-built binaries with others over HTTP.")))
-(define-deprecated (guix-publish-service #:key (guix guix)
- (port 80) (host "localhost"))
- guix-publish-service-type
- "Return a service that runs @command{guix publish} listening on @var{host}
-and @var{port} (@pxref{Invoking guix publish}).
-
-This assumes that @file{/etc/guix} already contains a signing key pair as
-created by @command{guix archive --generate-key} (@pxref{Invoking guix
-archive}). If that is not the case, the service will fail to start."
- ;; Deprecated.
- (service guix-publish-service-type
- (guix-publish-configuration (guix guix) (port port) (host host))))
-
\f
;;;
;;; Udev.
(when device
(restart-on-EINTR (swapoff device)))
#f)))
- (respawn? #f))))))
+ (respawn? #f))))
+ (description "Turn on the virtual memory swap area.")))
(define (swap-service device)
"Return a service that uses @var{device} as a swap device."
notably to select, copy, and paste text. The default options use the
@code{ps2} protocol, which works for both USB and PS/2 mice.")))
-(define-deprecated (gpm-service #:key (gpm gpm)
- (options %default-gpm-options))
- gpm-service-type
- "Run @var{gpm}, the general-purpose mouse daemon, with the given
-command-line @var{options}. GPM allows users to use the mouse in the console,
-notably to select, copy, and paste text. The default value of @var{options}
-uses the @code{ps2} protocol, which works for both USB and PS/2 mice.
-
-This service is not part of @var{%base-services}."
- ;; To test in QEMU, use "-usbdevice mouse" and then, in the monitor, use
- ;; "info mice" and "mouse_set X" to use the right mouse.
- (service gpm-service-type
- (gpm-configuration (gpm gpm) (options options))))
(define-record-type* <kmscon-configuration>
kmscon-configuration make-kmscon-configuration
(auto-login kmscon-configuration-auto-login
(default #f))
(hardware-acceleration? kmscon-configuration-hardware-acceleration?
- (default #f))) ; #t causes failure
+ (default #f)) ; #t causes failure
+ (font-engine kmscon-configuration-font-engine
+ (default "pango"))
+ (font-size kmscon-configuration-font-size
+ (default 12)))
(define kmscon-service-type
(shepherd-service-type
(login-program (kmscon-configuration-login-program config))
(login-arguments (kmscon-configuration-login-arguments config))
(auto-login (kmscon-configuration-auto-login config))
- (hardware-acceleration? (kmscon-configuration-hardware-acceleration? config)))
+ (hardware-acceleration? (kmscon-configuration-hardware-acceleration? config))
+ (font-engine (kmscon-configuration-font-engine config))
+ (font-size (kmscon-configuration-font-size config)))
(define kmscon-command
#~(list
#$(file-append kmscon "/bin/kmscon") "--login"
"--vt" #$virtual-terminal
"--no-switchvt" ;Prevent a switch to the virtual terminal.
+ "--font-engine" #$font-engine
+ "--font-size" #$(number->string font-size)
#$@(if hardware-acceleration? '("--hwaccel") '())
"--login" "--"
#$login-program #$@login-arguments
(requirement '(user-processes udev dbus-system))
(provision (list (symbol-append 'term- (string->symbol virtual-terminal))))
(start #~(make-forkexec-constructor #$kmscon-command))
- (stop #~(make-kill-destructor)))))))
+ (stop #~(make-kill-destructor)))))
+ (description "Start the @command{kmscon} virtual terminal emulator for the
+Linux @dfn{kernel mode setting} (KMS).")))
(define-record-type* <static-networking>
static-networking make-static-networking
(udev-configuration
(rules (list lvm2 fuse alsa-utils crda))))
+ (service sysctl-service-type)
+
(service special-files-service-type
`(("/bin/sh" ,(file-append bash "/bin/sh"))
("/usr/bin/env" ,(file-append coreutils "/bin/env"))))))
HCoop / jackhill / guix / guix.git / blobdiff