aboutsummaryrefslogtreecommitdiff
path: root/gnu/services
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/services')
-rw-r--r--gnu/services/admin.scm143
-rw-r--r--gnu/services/base.scm105
-rw-r--r--gnu/services/cuirass.scm3
-rw-r--r--gnu/services/databases.scm10
-rw-r--r--gnu/services/guix.scm46
-rw-r--r--gnu/services/lightdm.scm48
-rw-r--r--gnu/services/pm.scm61
-rw-r--r--gnu/services/shepherd.scm16
-rw-r--r--gnu/services/virtualization.scm5
-rw-r--r--gnu/services/vpn.scm135
-rw-r--r--gnu/services/web.scm16
11 files changed, 428 insertions, 160 deletions
diff --git a/gnu/services/admin.scm b/gnu/services/admin.scm
index 4882883878..4a2f5cb12d 100644
--- a/gnu/services/admin.scm
+++ b/gnu/services/admin.scm
@@ -3,6 +3,8 @@
;;; Copyright © 2016-2023 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
;;; Copyright © 2023 Giacomo Leidi <goodoldpaul@autistici.org>
+;;; Copyright © 2024 Gabriel Wicki <gabriel@erlikon.ch>
+;;; Copyright © 2024 Richard Sent <richard@freakingpenguin.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -20,11 +22,15 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu services admin)
+ #:use-module (gnu system file-systems)
#:use-module (gnu packages admin)
#:use-module ((gnu packages base)
#:select (canonical-package findutils coreutils sed))
+ #:use-module (gnu packages file-systems)
#:use-module (gnu packages certs)
+ #:use-module (gnu packages disk)
#:use-module (gnu packages package-management)
+ #:use-module (gnu packages linux)
#:use-module (gnu services)
#:use-module (gnu services configuration)
#:use-module (gnu services mcron)
@@ -93,7 +99,16 @@
unattended-upgrade-configuration-services-to-restart
unattended-upgrade-configuration-system-expiration
unattended-upgrade-configuration-maximum-duration
- unattended-upgrade-configuration-log-file))
+ unattended-upgrade-configuration-log-file
+
+ resize-file-system-service-type
+ resize-file-system-configuration
+ resize-file-system-configuration?
+ resize-file-system-configuration-file-system
+ resize-file-system-configuration-cloud-utils
+ resize-file-system-configuration-e2fsprogs
+ resize-file-system-configuration-btrfs-progs
+ resize-file-system-configuration-bcachefs-tools))
;;; Commentary:
;;;
@@ -512,11 +527,13 @@ which lets you search for packages that provide a given file.")
#$(string-append (number->string expiration)
"s")))
- (format #t "~a restarting services...~%" (timestamp))
- (for-each restart-service '#$services)
+ (unless #$reboot?
+ ;; Rebooting effectively restarts services anyway and execution
+ ;; would be halted here if mcron is restarted.
+ (format #t "~a restarting services...~%" (timestamp))
+ (for-each restart-service '#$services))
- ;; XXX: If 'mcron' has been restarted, perhaps this isn't
- ;; reached.
+ ;; XXX: If 'mcron' has been restarted, this is not reached.
(format #t "~a upgrade complete~%" (timestamp))
;; Stopping the root shepherd service triggers a reboot.
@@ -548,4 +565,120 @@ which lets you search for packages that provide a given file.")
"Periodically upgrade the system from the current configuration.")
(default-value (unattended-upgrade-configuration))))
+;;;
+;;; Resize file system.
+;;;
+
+(define-record-type* <resize-file-system-configuration>
+ resize-file-system-configuration make-resize-file-system-configuration
+ resize-file-system-configuration?
+ (file-system resize-file-system-file-system
+ (default #f))
+ (cloud-utils resize-file-system-cloud-utils
+ (default cloud-utils))
+ (e2fsprogs resize-file-system-e2fsprogs
+ (default e2fsprogs))
+ (btrfs-progs resize-file-system-btrfs-progs
+ (default btrfs-progs))
+ (bcachefs-tools resize-file-system-bcachefs-tools
+ (default bcachefs-tools)))
+
+(define (resize-file-system-shepherd-service config)
+ "Returns a <shepherd-service> for resize-file-system-service for CONFIG."
+ (match-record config <resize-file-system-configuration>
+ (file-system cloud-utils e2fsprogs btrfs-progs
+ bcachefs-tools)
+ (let ((fs-spec (file-system->spec file-system)))
+ (shepherd-service
+ (documentation "Resize a file system. Intended for Guix Systems that
+are booted from a system image flashed onto a larger medium.")
+ ;; XXX: This could be extended with file-system info.
+ (provision '(resize-file-system))
+ (requirement '(user-processes))
+ (one-shot? #t)
+ (respawn? #f)
+ (modules '((guix build utils)
+ (gnu build file-systems)
+ (gnu system file-systems)
+ (ice-9 control)
+ (ice-9 match)
+ (ice-9 ftw)
+ (ice-9 rdelim)
+ (srfi srfi-34)))
+ (start (with-imported-modules (source-module-closure
+ '((guix build utils)
+ (gnu build file-systems)
+ (gnu system file-systems)))
+ #~(lambda _
+ (use-modules (guix build utils)
+ (gnu build file-systems)
+ (gnu system file-systems)
+ (ice-9 control)
+ (ice-9 match)
+ (ice-9 ftw)
+ (ice-9 rdelim)
+ (srfi srfi-34))
+
+ (define file-system
+ (spec->file-system '#$fs-spec))
+
+ ;; Shepherd recommends the start constructor takes <1
+ ;; minute, canonicalize-device-spec will hang for up to
+ ;; max-trials seconds (20 seconds) if an invalid device is
+ ;; connected. Revisit this if max-trials increases.
+ (define device (canonicalize-device-spec
+ (file-system-device file-system)))
+
+ (define grow-partition-command
+ (let* ((sysfs-device
+ (string-append "/sys/class/block/"
+ (basename device)))
+ (partition-number
+ (with-input-from-file
+ (string-append sysfs-device
+ "/partition")
+ read-line))
+ (parent (string-append
+ "/dev/"
+ (basename (dirname (readlink sysfs-device))))))
+ (list #$(file-append cloud-utils "/bin/growpart")
+ parent partition-number)))
+
+ (define grow-filesystem-command
+ (match (file-system-type file-system)
+ ((or "ext2" "ext3" "ext4")
+ (list #$(file-append e2fsprogs "/sbin/resize2fs") device))
+ ("btrfs"
+ (list #$(file-append btrfs-progs "/bin/btrfs")
+ "filesystem" "resize" device))
+ ("bcachefs"
+ (list #$(file-append bcachefs-tools "/sbin/bcachefs")
+ "device" "resize" device))
+ (e (error "Unsupported filesystem type" e))))
+
+ (let/ec return
+ (guard (c ((and (invoke-error? c)
+ ;; growpart NOCHANGE exits with 1. It is
+ ;; unlikely the partition was resized
+ ;; while the file system was not. Just
+ ;; exit.
+ (equal? (invoke-error-exit-status c) 1))
+ (format (current-error-port)
+ "The device ~a is already resized.~%" device)
+ ;; Must return something or Shepherd considers
+ ;; the service perpetually starting.
+ (return 0)))
+ (apply invoke grow-partition-command))
+ (apply invoke grow-filesystem-command)))))))))
+
+(define resize-file-system-service-type
+ (service-type
+ (name 'resize-file-system)
+ (description "Resize a partition and the underlying file system during boot.")
+ (extensions
+ (list
+ (service-extension shepherd-root-service-type
+ (compose list resize-file-system-shepherd-service))))
+ (default-value (resize-file-system-configuration))))
+
;;; admin.scm ends here
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 7b053ef784..766371ecf1 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -44,6 +44,7 @@
#:autoload (guix diagnostics) (warning formatted-message &fix-hint)
#:autoload (guix i18n) (G_)
#:use-module (guix combinators)
+ #:use-module (guix utils)
#:use-module (gnu services)
#:use-module (gnu services admin)
#:use-module (gnu services shepherd)
@@ -186,6 +187,13 @@
mingetty-configuration-login-pause?
mingetty-configuration-clear-on-logout?
mingetty-configuration-mingetty
+ mingetty-configuration-delay
+ mingetty-configuration-print-issue
+ mingetty-configuration-print-hostname
+ mingetty-configuration-nice
+ mingetty-configuration-working-directory
+ mingetty-configuration-root-directory
+ mingetty-configuration-shepherd-requirement
mingetty-configuration?
mingetty-service ; deprecated
mingetty-service-type
@@ -1239,31 +1247,49 @@ the tty to run, among other things."
(define-record-type* <mingetty-configuration>
mingetty-configuration make-mingetty-configuration
mingetty-configuration?
- (mingetty mingetty-configuration-mingetty ;file-like
- (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)))
+ (mingetty mingetty-configuration-mingetty ;file-like
+ (default mingetty))
+ (tty mingetty-configuration-tty) ;string
+ (auto-login mingetty-configuration-auto-login ;string | #f
+ (default #f))
+ (login-program mingetty-configuration-login-program ;gexp
+ (default #f))
+ (login-pause? mingetty-configuration-login-pause? ;boolean
+ (default #f))
+ (clear-on-logout? mingetty-configuration-clear-on-logout? ;boolean
+ (default #t))
+ (delay mingetty-configuration-delay ;integer | #f
+ (default #f))
+ (print-issue mingetty-configuration-print-issue ;boolean | Symbol
+ (default #t))
+ (print-hostname mingetty-configuration-print-hostname ;boolean | Symbol
+ (default #t))
+ (nice mingetty-configuration-nice ;integer | #f
+ (default #f))
+ (working-directory mingetty-configuration-working-directory ;string | #f
+ (default #f))
+ (root-directory mingetty-configuration-root-directory ;string | #f
+ (default #f))
+ (shepherd-requirement mingetty-configuration-shepherd-requirement
+ ;; Since the login prompt shows the host name, wait
+ ;; for the 'host-name' service to be done. Also wait
+ ;; for udev essentially so that the tty text is not
+ ;; lost in the middle of kernel messages (XXX).
+ (default '(user-processes host-name udev
+ virtual-terminal))))
(define (mingetty-shepherd-service config)
(match-record config <mingetty-configuration>
- (mingetty tty auto-login login-program
- login-pause? clear-on-logout?)
+ ( mingetty tty auto-login login-program
+ login-pause? clear-on-logout? delay
+ print-issue print-hostname nice
+ working-directory root-directory shepherd-requirement)
(list
(shepherd-service
(documentation "Run mingetty on an tty.")
(provision (list (symbol-append 'term- (string->symbol tty))))
- ;; Since the login prompt shows the host name, wait for the 'host-name'
- ;; service to be done. Also wait for udev essentially so that the tty
- ;; text is not lost in the middle of kernel messages (XXX).
- (requirement '(user-processes host-name udev virtual-terminal))
+ (requirement shepherd-requirement)
(start #~(make-forkexec-constructor
(list #$(file-append mingetty "/sbin/mingetty")
@@ -1285,6 +1311,32 @@ the tty to run, among other things."
#~())
#$@(if login-pause?
#~("--loginpause")
+ #~())
+ #$@(if delay
+ #~("--delay" #$(number->string delay))
+ #~())
+ #$@(match print-issue
+ (#t
+ #~())
+ ('no-nl
+ #~("--nonewline"))
+ (#f
+ #~("--noissue")))
+ #$@(match print-hostname
+ (#t
+ #~())
+ ('long
+ #~("--long-hostname"))
+ (#f
+ #~("--nohostname")))
+ #$@(if nice
+ #~("--nice" #$(number->string nice))
+ #~())
+ #$@(if working-directory
+ #~("--chdir" #$working-directory)
+ #~())
+ #$@(if root-directory
+ #~("--chroot" #$root-directory)
#~()))))
(stop #~(make-kill-destructor))))))
@@ -2677,7 +2729,7 @@ NAME-udev-hardware."
(with-imported-modules (source-module-closure '((gnu build file-systems)))
(shepherd-service
(provision (list (swap->shepherd-service-name swap)))
- (requirement `(udev ,@requirements))
+ (requirement `(,@(if (target-hurd?) '() '(udev)) ,@requirements))
(documentation "Enable the given swap space.")
(modules `((gnu build file-systems)
,@%default-modules))
@@ -2685,16 +2737,21 @@ NAME-udev-hardware."
(let ((device #$device-lookup))
(and device
(begin
- (restart-on-EINTR (swapon device
- #$(if (swap-space? swap)
- (swap-space->flags-bit-mask
- swap)
- 0)))
+ #$(if (target-hurd?)
+ #~(system* "swapon" device)
+ #~(restart-on-EINTR
+ (swapon device
+ #$(if (swap-space? swap)
+ (swap-space->flags-bit-mask
+ swap)
+ 0))))
#t)))))
(stop #~(lambda _
(let ((device #$device-lookup))
(when device
- (restart-on-EINTR (swapoff device)))
+ #$(if (target-hurd?)
+ #~(system* "swapoff" device)
+ #~(restart-on-EINTR (swapoff device))))
#f)))
(respawn? #f))))
(description "Turn on the virtual memory swap area.")))
diff --git a/gnu/services/cuirass.scm b/gnu/services/cuirass.scm
index 187766bc99..cc5cd62672 100644
--- a/gnu/services/cuirass.scm
+++ b/gnu/services/cuirass.scm
@@ -184,7 +184,8 @@
#$@extra-options)
#:environment-variables
- (list "GIT_SSL_CAINFO=/etc/ssl/certs/ca-certificates.crt"
+ (list "LC_ALL=C.UTF-8" ;for proper file name decoding
+ "GIT_SSL_CAINFO=/etc/ssl/certs/ca-certificates.crt"
(string-append "GIT_EXEC_PATH=" #$git
"/libexec/git-core"))
diff --git a/gnu/services/databases.scm b/gnu/services/databases.scm
index 0933eb5e79..e8a4acc996 100644
--- a/gnu/services/databases.scm
+++ b/gnu/services/databases.scm
@@ -167,8 +167,11 @@ host all all ::1/128 md5"))
(define-record-type* <postgresql-configuration>
postgresql-configuration make-postgresql-configuration
postgresql-configuration?
- (postgresql postgresql-configuration-postgresql ;file-like
- (default postgresql))
+ ;; Setting no default ensures that the user sets its current postgresql
+ ;; explicitely. Since major upgrades currently require a manual migration
+ ;; of the database, this way the user is responsible for upgrading properly.
+ ;; MAYBE TODO: Write an action to automatically upgrade in Guix.
+ (postgresql postgresql-configuration-postgresql) ;file-like
(port postgresql-configuration-port
(default 5432))
(locale postgresql-configuration-locale
@@ -343,10 +346,9 @@ host all all ::1/128 md5"))
(service-extension
profile-service-type
(compose list postgresql-configuration-postgresql))))
- (default-value (postgresql-configuration))
(description "Run the PostgreSQL database server.")))
-(define-deprecated (postgresql-service #:key (postgresql postgresql)
+(define-deprecated (postgresql-service #:key (postgresql postgresql-10)
(port 5432)
(locale "en_US.utf8")
(config-file (postgresql-config-file))
diff --git a/gnu/services/guix.scm b/gnu/services/guix.scm
index 6c58b3a292..7a399238ef 100644
--- a/gnu/services/guix.scm
+++ b/gnu/services/guix.scm
@@ -100,6 +100,8 @@
guix-data-service-host
guix-data-service-getmail-idle-mailboxes
guix-data-service-commits-getmail-retriever-configuration
+ guix-data-service-configuration-git-repositories
+ guix-data-service-configuration-build-servers
guix-data-service-type
@@ -556,7 +558,11 @@
(default '()))
(extra-process-jobs-options
guix-data-service-extra-process-jobs-options
- (default '())))
+ (default '()))
+ (git-repositories guix-data-service-configuration-git-repositories
+ (default #f))
+ (build-servers guix-data-service-configuration-build-servers
+ (default #f)))
(define (guix-data-service-profile-packages config)
"Return the guix-data-service package, this will populate the
@@ -566,7 +572,8 @@ ca-certificates.crt file in the system profile."
(define (guix-data-service-shepherd-services config)
(match-record config <guix-data-service-configuration>
- (package user group port host extra-options extra-process-jobs-options)
+ (package user group port host extra-options extra-process-jobs-options
+ git-repositories build-servers)
(list
(shepherd-service
(documentation "Guix Data Service web server")
@@ -596,6 +603,41 @@ ca-certificates.crt file in the system profile."
(stop #~(make-kill-destructor)))
(shepherd-service
+ (documentation "Guix Data Service setup database")
+ (provision '(guix-data-service-setup-database))
+ (requirement '(postgres))
+ (one-shot? #t)
+ (start
+ (with-extensions (cons package
+ ;; This is a poorly constructed Guile load path,
+ ;; since it contains things that aren't Guile
+ ;; libraries, but it means that the Guile
+ ;; libraries needed for the Guix Data Service
+ ;; don't need to be individually specified here.
+ (append
+ (map second (package-inputs package))
+ (map second (package-propagated-inputs package))))
+ #~(lambda _
+ (use-modules (guix-data-service database)
+ (guix-data-service model git-repository)
+ (guix-data-service model build-server))
+
+ (begin
+ ((@ (guix-data-service database) run-sqitch))
+
+ #$@(if git-repositories
+ #~(((@ (guix-data-service model git-repository)
+ specify-git-repositories)
+ '(#$@git-repositories)))
+ '())
+ #$@(if build-servers
+ #~(((@ (guix-data-service model build-server)
+ specify-build-servers)
+ '(#$@build-servers)))
+ '())))))
+ (auto-start? #t))
+
+ (shepherd-service
(documentation "Guix Data Service process jobs")
(provision '(guix-data-service-process-jobs))
(requirement '(postgres networking))
diff --git a/gnu/services/lightdm.scm b/gnu/services/lightdm.scm
index 798c106563..191cb5635b 100644
--- a/gnu/services/lightdm.scm
+++ b/gnu/services/lightdm.scm
@@ -397,15 +397,6 @@ When unspecified, listen for any hosts/IP addresses.")
(list-of-strings '())
"Extra configuration values to append to the LightDM configuration file."))
-(define (lightdm-configuration->greeters-config-dir config)
- "Return a directory containing all the serialized greeter configurations
-from CONFIG, a <lightdm-configuration> object."
- (file-union "etc-lightdm"
- (append-map (lambda (g)
- `((,(greeter-configuration->conf-name g)
- ,(greeter-configuration->file g))))
- (lightdm-configuration-greeters config))))
-
(define (lightdm-configuration->packages config)
"Return all the greeter packages and their assets defined in CONFIG, a
<lightdm-configuration> object, as well as the lightdm package itself."
@@ -496,6 +487,16 @@ port=" (number->string vnc-server-port) "\n"
lightdm-seat-configuration-fields)))
seats))))
+(define (lightdm-configuration-directory config)
+ "Return a directory containing the serialized lightdm configuration
+and all the serialized greeter configurations from CONFIG."
+ (file-union "etc-lightdm"
+ (cons `("lightdm.conf" ,(lightdm-configuration-file config))
+ (map (lambda (g)
+ `(,(greeter-configuration->conf-name g)
+ ,(greeter-configuration->file g)))
+ (lightdm-configuration-greeters config)))))
+
(define %lightdm-accounts
(list (user-group (name "lightdm") (system? #t))
(user-account
@@ -589,9 +590,7 @@ port=" (number->string vnc-server-port) "\n"
"/sbin/lightdm")
#$@(if (lightdm-configuration-debug? config)
#~("--debug")
- #~())
- "--config"
- #$(lightdm-configuration-file config)))
+ #~())))
(define lightdm-paths
(let ((lightdm (lightdm-configuration-lightdm config)))
@@ -601,9 +600,6 @@ port=" (number->string vnc-server-port) "\n"
'("/bin" "/sbin" "/libexec"))
":")))
- (define greeters-config-dir
- (lightdm-configuration->greeters-config-dir config))
-
(define data-dirs
;; LightDM itself needs to be in XDG_DATA_DIRS for the accountsservice
;; interface it provides to be picked up. The greeters must also be in
@@ -626,11 +622,7 @@ port=" (number->string vnc-server-port) "\n"
;; Lightdm needs itself in its PATH.
#:environment-variables
(list
- ;; It knows to look for greeter
- ;; configurations in XDG_CONFIG_DIRS...
- (string-append "XDG_CONFIG_DIRS="
- #$greeters-config-dir)
- ;; ... and for greeter .desktop files as
+ ;; It looks for greeter .desktop files as
;; well as lightdm accountsservice
;; interface in XDG_DATA_DIRS.
(string-append "XDG_DATA_DIRS="
@@ -638,6 +630,11 @@ port=" (number->string vnc-server-port) "\n"
(string-append "PATH=" #$lightdm-paths))))
(stop #~(make-kill-destructor)))))
+(define (lightdm-etc-service config)
+ "Return a list of FILES for @var{etc-service-type} to build the
+/etc/lightdm directory using CONFIG"
+ (list `("lightdm" ,(lightdm-configuration-directory config))))
+
(define lightdm-service-type
(handle-xorg-configuration
lightdm-configuration
@@ -666,13 +663,10 @@ port=" (number->string vnc-server-port) "\n"
;; https://github.com/NixOS/nixpkgs/issues/45059.
(service-extension profile-service-type
lightdm-configuration->packages)
- ;; This is needed for the greeter itself to find its configuration,
- ;; because XDG_CONF_DIRS gets overridden by /etc/profile.
- (service-extension
- etc-service-type
- (lambda (config)
- `(("lightdm"
- ,(lightdm-configuration->greeters-config-dir config)))))))
+ ;; This is needed for lightdm and greeter
+ ;; to find their configuration
+ (service-extension etc-service-type
+ lightdm-etc-service)))
(description "Run @code{lightdm}, the LightDM graphical login manager."))))
diff --git a/gnu/services/pm.scm b/gnu/services/pm.scm
index 47f0bf7812..1978de55d4 100644
--- a/gnu/services/pm.scm
+++ b/gnu/services/pm.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2024 Dariqq <dariqq@posteo.net>
+;;; Copyright © 2024 Ian Eure <ian@retrospec.tv>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -18,6 +19,8 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu services pm)
+ #:use-module (srfi srfi-1)
+ #:use-module (ice-9 match)
#:use-module (guix gexp)
#:use-module (guix packages)
#:use-module (guix records)
@@ -37,7 +40,10 @@
tlp-configuration
thermald-configuration
- thermald-service-type))
+ thermald-service-type
+
+ powertop-configuration
+ powertop-service-type))
;;;
;;; power-profiles-daemon
@@ -52,14 +58,15 @@
(match-record
config <power-profiles-daemon-configuration>
(power-profiles-daemon)
- (list (shepherd-service
- (provision '(power-profiles-daemon))
- (requirement '(dbus-system))
- (documentation "Run the power-profiles-daemon.")
- (start #~(make-forkexec-constructor
- (list #$(file-append power-profiles-daemon
- "/libexec/power-profiles-daemon"))))
- (stop #~(make-kill-destructor))))))
+ (list
+ (shepherd-service
+ (provision '(power-profiles-daemon))
+ (requirement '(user-processes dbus-system))
+ (documentation "Run the Power Profiles Daemon.")
+ (start #~(make-forkexec-constructor
+ (list #$(file-append power-profiles-daemon
+ "/libexec/power-profiles-daemon"))))
+ (stop #~(make-kill-destructor))))))
(define %power-profiles-daemon-activation
#~(begin
@@ -83,7 +90,7 @@
(service-extension activation-service-type
(const %power-profiles-daemon-activation))))
(default-value (power-profiles-daemon-configuration))
- (description "Run the power-profiles-daemon"))))
+ (description "Run the Power Profiles Daemon"))))
@@ -524,3 +531,37 @@ shutdown on system startup."))
(default-value (thermald-configuration))
(description "Run thermald, a CPU frequency scaling service that helps
prevent overheating.")))
+
+
+
+;;;
+;;; powertop
+;;;
+;;; Calls `powertop --auto-tune' to reduce energy consumption.
+
+(define-configuration powertop-configuration
+ (powertop (package powertop) "PowerTOP package to use."))
+
+(define powertop-shepherd-service
+ (match-lambda
+ (($ <powertop-configuration> powertop)
+ (shepherd-service
+ (documentation "Tune kernel power settings at boot.")
+ (provision '(powertop powertop-auto-tune))
+ (requirement '(user-processes))
+ (one-shot? #t)
+ (start #~(lambda _
+ (zero? (system* #$(file-append powertop "/sbin/powertop")
+ "--auto-tune"))))))))
+
+(define powertop-service-type
+ (service-type
+ (name 'powertop)
+ (extensions
+ (list
+ (service-extension shepherd-root-service-type
+ (compose list powertop-shepherd-service))))
+ (compose concatenate)
+ (default-value (powertop-configuration))
+ (description "Tune power-related kernel parameters to reduce energy
+ consumption.")))
diff --git a/gnu/services/shepherd.scm b/gnu/services/shepherd.scm
index 05534ab317..0de3c9c55c 100644
--- a/gnu/services/shepherd.scm
+++ b/gnu/services/shepherd.scm
@@ -95,7 +95,7 @@
shepherd-configuration make-shepherd-configuration
shepherd-configuration?
(shepherd shepherd-configuration-shepherd
- (default shepherd-0.10)) ; file-like
+ (default shepherd-1.0)) ;file-like
(services shepherd-configuration-services
(default '()))) ; list of <shepherd-service>
@@ -407,20 +407,6 @@ as shepherd package."
(module-use! m (resolve-interface '(shepherd service)))
m))
- ;; There's code run from shepherd that uses 'call-with-input-file' &
- ;; co.--e.g., the 'urandom-seed' service. Starting from Shepherd
- ;; 0.9.2, users need to make sure not to leak non-close-on-exec file
- ;; descriptors to child processes. To address that, replace the
- ;; standard bindings with O_CLOEXEC variants.
- (set! call-with-input-file
- (lambda (file proc)
- (call-with-port (open file (logior O_RDONLY O_CLOEXEC))
- proc)))
- (set! call-with-output-file
- (lambda (file proc)
- (call-with-port (open file (logior O_WRONLY O_CREAT O_CLOEXEC))
- proc)))
-
;; Specify the default environment visible to all the services.
;; Without this statement, all the environment variables of PID 1
;; are inherited by child services.
diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm
index d87e494348..53f79e367b 100644
--- a/gnu/services/virtualization.scm
+++ b/gnu/services/virtualization.scm
@@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Ryan Moe <ryan.moe@gmail.com>
;;; Copyright © 2018, 2020-2024 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2020, 2021, 2023 Janneke Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2020, 2021, 2023, 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2021 Timotej Lazar <timotej.lazar@araneo.si>
;;; Copyright © 2022 Oleg Pykhalov <go.wigust@gmail.com>
;;; Copyright © 2022 Leo Nikkilä <hello@lnikki.la>
@@ -1643,7 +1643,7 @@ preventing password-based authentication as 'root'."
;; /etc/guix/acl file in the childhurd. Thus, clear
;; 'authorize-key?' so that it's not overridden at activation
;; time.
- (modify-services %base-services/hurd
+ (modify-services %base-services+qemu-networking/hurd
(guix-service-type config =>
(guix-configuration
(inherit config)
@@ -1841,6 +1841,7 @@ machines in /etc/guix/machines.scm."
(@ (ice-9 textual-ports)
get-string-all)))
(user "offloading")
+ (overload-threshold 1.8) ;current load reporting is off by 1
(private-key #$host-ssh-key))))))
(guix-extension)))
diff --git a/gnu/services/vpn.scm b/gnu/services/vpn.scm
index 7fb4775757..8e90032c93 100644
--- a/gnu/services/vpn.scm
+++ b/gnu/services/vpn.scm
@@ -12,6 +12,7 @@
;;; Copyright © 2022 Cameron V Chaparro <cameron@cameronchaparro.com>
;;; Copyright © 2022 Timo Wilken <guix@twilken.net>
;;; Copyright © 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2024 Richard Sent <richard@freakingpenguin.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -80,6 +81,7 @@
wireguard-configuration-monitor-ips?
wireguard-configuration-monitor-ips-interval
wireguard-configuration-private-key
+ wireguard-configuration-bootstrap-private-key?
wireguard-configuration-peers
wireguard-configuration-pre-up
wireguard-configuration-post-up
@@ -733,34 +735,36 @@ strongSwan.")))
(define-record-type* <wireguard-configuration>
wireguard-configuration make-wireguard-configuration
wireguard-configuration?
- (wireguard wireguard-configuration-wireguard ;file-like
- (default wireguard-tools))
- (interface wireguard-configuration-interface ;string
- (default "wg0"))
- (addresses wireguard-configuration-addresses ;string
- (default '("10.0.0.1/32")))
- (port wireguard-configuration-port ;integer
- (default 51820))
- (private-key wireguard-configuration-private-key ;string
- (default "/etc/wireguard/private.key"))
- (peers wireguard-configuration-peers ;list of <wiregard-peer>
- (default '()))
- (dns wireguard-configuration-dns ;list of strings
- (default '()))
- (monitor-ips? wireguard-configuration-monitor-ips? ;boolean
- (default #f))
- (monitor-ips-interval wireguard-configuration-monitor-ips-interval
- (default '(next-minute (range 0 60 5)))) ;string | list
- (pre-up wireguard-configuration-pre-up ;list of strings
- (default '()))
- (post-up wireguard-configuration-post-up ;list of strings
- (default '()))
- (pre-down wireguard-configuration-pre-down ;list of strings
- (default '()))
- (post-down wireguard-configuration-post-down ;list of strings
- (default '()))
- (table wireguard-configuration-table ;string
- (default "auto")))
+ (wireguard wireguard-configuration-wireguard ;file-like
+ (default wireguard-tools))
+ (interface wireguard-configuration-interface ;string
+ (default "wg0"))
+ (addresses wireguard-configuration-addresses ;string
+ (default '("10.0.0.1/32")))
+ (port wireguard-configuration-port ;integer
+ (default 51820))
+ (private-key wireguard-configuration-private-key ;maybe-string
+ (default "/etc/wireguard/private.key"))
+ (bootstrap-private-key? wireguard-configuration-bootstrap-private-key? ;boolean
+ (default #t))
+ (peers wireguard-configuration-peers ;list of <wiregard-peer>
+ (default '()))
+ (dns wireguard-configuration-dns ;list of strings
+ (default '()))
+ (monitor-ips? wireguard-configuration-monitor-ips? ;boolean
+ (default #f))
+ (monitor-ips-interval wireguard-configuration-monitor-ips-interval
+ (default '(next-minute (range 0 60 5)))) ;string | list
+ (pre-up wireguard-configuration-pre-up ;list of strings
+ (default '()))
+ (post-up wireguard-configuration-post-up ;list of strings
+ (default '()))
+ (pre-down wireguard-configuration-pre-down ;list of strings
+ (default '()))
+ (post-down wireguard-configuration-post-down ;list of strings
+ (default '()))
+ (table wireguard-configuration-table ;string
+ (default "auto")))
(define (wireguard-configuration-file config)
(define (peer->config peer)
@@ -797,30 +801,33 @@ strongSwan.")))
(define lines
(list
"[Interface]"
- #$@(if (null? addresses)
- '()
- (list (format #f "Address = ~{~a~^, ~}"
- addresses)))
+ (if (null? '#$addresses)
+ ""
+ (format #f "Address = ~{~a~^, ~}"
+ (list #$@addresses)))
(format #f "~@[Table = ~a~]" #$table)
- #$@(if (null? pre-up)
- '()
- (list (format #f "~{PreUp = ~a~%~}" pre-up)))
- (format #f "PostUp = ~a set %i private-key ~a\
-~{ peer ~a preshared-key ~a~}" #$(file-append wireguard "/bin/wg")
-#$private-key '#$peer-keys)
- #$@(if (null? post-up)
- '()
- (list (format #f "~{PostUp = ~a~%~}" post-up)))
- #$@(if (null? pre-down)
- '()
- (list (format #f "~{PreDown = ~a~%~}" pre-down)))
- #$@(if (null? post-down)
- '()
- (list (format #f "~{PostDown = ~a~%~}" post-down)))
+ (if (null? '#$pre-up)
+ ""
+ (format #f "~{PreUp = ~a~%~}" (list #$@pre-up)))
+ (if #$private-key
+ (format #f "PostUp = ~a set %i private-key ~a\
+~{ peer ~a preshared-key ~a~}"
+ #$(file-append wireguard "/bin/wg")
+ #$private-key (list #$@peer-keys))
+ "")
+ (if (null? '#$post-up)
+ ""
+ (format #f "~{PostUp = ~a~%~}" (list #$@post-up)))
+ (if (null? '#$pre-down)
+ ""
+ (format #f "~{PreDown = ~a~%~}" (list #$@pre-down)))
+ (if (null? '#$post-down)
+ ""
+ (format #f "~{PostDown = ~a~%~}" (list #$@post-down)))
(format #f "~@[ListenPort = ~a~]" #$port)
- #$@(if (null? dns)
- '()
- (list (format #f "DNS = ~{~a~^, ~}" dns)))))
+ (if (null? '#$dns)
+ ""
+ (format #f "DNS = ~{~a~^, ~}" (list #$@dns)))))
(mkdir #$output)
(chdir #$output)
@@ -833,23 +840,25 @@ strongSwan.")))
(define (wireguard-activation config)
(match-record config <wireguard-configuration>
- (private-key wireguard)
+ (private-key bootstrap-private-key? wireguard)
#~(begin
(use-modules (guix build utils)
(ice-9 popen)
(ice-9 rdelim))
- (mkdir-p (dirname #$private-key))
- (unless (file-exists? #$private-key)
- (let* ((pipe
- (open-input-pipe (string-append
- #$(file-append wireguard "/bin/wg")
- " genkey")))
- (key (read-line pipe)))
- (call-with-output-file #$private-key
- (lambda (port)
- (display key port)))
- (chmod #$private-key #o400)
- (close-pipe pipe))))))
+ (when (and #$private-key
+ #$bootstrap-private-key?)
+ (mkdir-p (dirname #$private-key))
+ (unless (file-exists? #$private-key)
+ (let* ((pipe
+ (open-input-pipe (string-append
+ #$(file-append wireguard "/bin/wg")
+ " genkey")))
+ (key (read-line pipe)))
+ (call-with-output-file #$private-key
+ (lambda (port)
+ (display key port)))
+ (chmod #$private-key #o400)
+ (close-pipe pipe)))))))
;;; XXX: Copied from (guix scripts pack), changing define to define*.
(define-syntax-rule (define-with-source (variable args ...) body body* ...)
diff --git a/gnu/services/web.scm b/gnu/services/web.scm
index 4cf7c68997..3997fe2ab8 100644
--- a/gnu/services/web.scm
+++ b/gnu/services/web.scm
@@ -704,8 +704,10 @@ of index files."
(cons
"\n"
(map (lambda (line)
- (simple-format #f " ~A\n" line))
- (flatten extra-content)))
+ `(" " ,line "\n"))
+ (if (list? extra-content)
+ extra-content
+ (list extra-content))))
'()))
" }\n"))
@@ -771,10 +773,7 @@ of index files."
(number->string server-names-hash-bucket-max-size)
";\n")
"")
- "\n"
- (map emit-nginx-upstream-config upstream-blocks)
- (map emit-nginx-server-config server-blocks)
- (match extra-content
+ (match extra-content
((? list? extra-content)
(map (lambda (line)
`(" " ,line "\n"))
@@ -782,7 +781,10 @@ of index files."
;; XXX: For compatibility strings and gexp's are inserted
;; directly.
(_ extra-content))
- "\n}\n"))))
+ "\n"
+ (map emit-nginx-upstream-config upstream-blocks)
+ (map emit-nginx-server-config server-blocks)
+ "}\n"))))
(define %nginx-accounts
(list (user-group (name "nginx") (system? #t))
generated by cgit v1.2.3 (git 2.49.0) at 2025-08-07 15:05:28 +0000