;;; 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>
#: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
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
(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
(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)))))
+ (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-deprecated (console-keymap-service #:rest files)
#f
(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 "()")))
(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
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
(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."
(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