summary refs log tree commit diff
path: root/gnu/services/base.scm
diff options
context:
space:
mode:
authorMaxim Cournoyer <maxim.cournoyer@gmail.com>2023-04-14 16:57:37 -0400
committerMaxim Cournoyer <maxim.cournoyer@gmail.com>2023-04-14 17:15:08 -0400
commit3bacd3c76a58ebe70f98be654f09cbd4166093ab (patch)
tree89f687565205971a9925d33400235968a569a069 /gnu/services/base.scm
parentdf3391c0309443ac37f9a9a6b1038a85454b8ee6 (diff)
parent97ed675718b948319e6f6e51f2d577971bea1176 (diff)
downloadguix-3bacd3c76a58ebe70f98be654f09cbd4166093ab.tar.gz
Merge branch 'master' into core-updates.
Conflicts:
	gnu/local.mk
	gnu/packages/build-tools.scm
	gnu/packages/certs.scm
	gnu/packages/check.scm
	gnu/packages/compression.scm
	gnu/packages/cups.scm
	gnu/packages/fontutils.scm
	gnu/packages/gnuzilla.scm
	gnu/packages/guile.scm
	gnu/packages/ibus.scm
	gnu/packages/image-processing.scm
	gnu/packages/linux.scm
	gnu/packages/music.scm
	gnu/packages/nss.scm
	gnu/packages/pdf.scm
	gnu/packages/python-xyz.scm
	gnu/packages/qt.scm
	gnu/packages/ruby.scm
	gnu/packages/shells.scm
	gnu/packages/tex.scm
	gnu/packages/video.scm
	gnu/packages/vulkan.scm
	gnu/packages/web.scm
	gnu/packages/webkit.scm
	gnu/packages/wm.scm
Diffstat (limited to 'gnu/services/base.scm')
-rw-r--r--gnu/services/base.scm129
1 files changed, 57 insertions, 72 deletions
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 190bb8fe24..e5c6bf5335 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013-2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013-2023 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2015, 2016, 2020 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
@@ -40,7 +40,7 @@
 (define-module (gnu services base)
   #:use-module (guix store)
   #:use-module (guix deprecation)
-  #:autoload   (guix diagnostics) (warning &fix-hint)
+  #:autoload   (guix diagnostics) (warning formatted-message &fix-hint)
   #:autoload   (guix i18n) (G_)
   #:use-module (guix combinators)
   #:use-module (gnu services)
@@ -223,7 +223,6 @@
             guix-publish-configuration-port
             guix-publish-configuration-host
             guix-publish-configuration-compression
-            guix-publish-configuration-compression-level ;deprecated
             guix-publish-configuration-nar-path
             guix-publish-configuration-cache
             guix-publish-configuration-ttl
@@ -246,7 +245,7 @@
             kmscon-service-type
 
             pam-limits-service-type
-            pam-limits-service
+            pam-limits-service  ; deprecated
 
             greetd-service-type
             greetd-configuration
@@ -703,9 +702,10 @@ to add @var{device} to the kernel's entropy pool.  The service will fail if
 ;;; /etc/hosts
 ;;;
 
-(define (valid-name? name)
-  "Return true if @var{name} is likely to be a valid host name."
-  (false-if-exception (not (string-any char-set:whitespace name))))
+(eval-when (expand load eval)
+  (define (valid-name? name)
+    "Return true if @var{name} is likely to be a valid host name."
+    (false-if-exception (not (string-any char-set:whitespace name)))))
 
 (define-compile-time-procedure (assert-valid-name (name valid-name?))
   "Ensure @var{name} is likely to be a valid host name."
@@ -813,21 +813,6 @@ host names."
    #t                                             ;default to UTF-8
    (description "Ensure the Linux virtual terminals run in UTF-8 mode.")))
 
-(define console-keymap-service-type
-  (shepherd-service-type
-   'console-keymap
-   (lambda (files)
-     (shepherd-service
-      (documentation (string-append "Load console keymap (loadkeys)."))
-      (provision '(console-keymap))
-      (start #~(lambda _
-                 (zero? (system* #$(file-append kbd "/bin/loadkeys")
-                                 #$@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: the 'font-gnu-unifont' package cannot be cross-compiled (yet), but
   ;; its "psf" output is the same whether it's built natively or not, hence
@@ -900,14 +885,6 @@ package or any valid argument to @command{setfont}, as in this example:
                  \"/share/consolefonts/ter-132n\"))) ; for HDPI
 @end example\n")))
 
-(define* (console-font-service tty #:optional (font "LatGrkCyr-8x16"))
-  "This procedure is deprecated in favor of @code{console-font-service-type}.
-
-Return a service that sets up Unicode support in @var{tty} and loads
-@var{font} for that tty (fonts are per virtual console in Linux.)"
-  (simple-service (symbol-append 'console-font- (string->symbol tty))
-                  console-font-service-type `((,tty . ,font))))
-
 (define %default-motd
   (plain-file "motd" "This is the GNU operating system, welcome!\n\n"))
 
@@ -1553,14 +1530,17 @@ Service Switch}, for an example."
   (shepherd-service-type
    'syslog
    (lambda (config)
+     (define config-file
+       (syslog-configuration-config-file config))
+
      (shepherd-service
       (documentation "Run the syslog daemon (syslogd).")
       (provision '(syslogd))
       (requirement '(user-processes))
+      (actions (list (shepherd-configuration-action config-file)))
       (start #~(let ((spawn (make-forkexec-constructor
                              (list #$(syslog-configuration-syslogd config)
-                                   "--rcfile"
-                                   #$(syslog-configuration-config-file config))
+                                   "--rcfile" #$config-file)
                              #:pid-file "/var/run/syslog.pid")))
                  (lambda ()
                    ;; Set the umask such that file permissions are #o640.
@@ -1584,17 +1564,13 @@ information on the configuration file syntax."
 
 
 (define pam-limits-service-type
-  (let ((security-limits
-         ;; Create /etc/security containing the provided "limits.conf" file.
-         (lambda (limits-file)
-           `(("security/limits.conf"
-              ,limits-file))))
-        (pam-extension
+  (let ((pam-extension
          (lambda (pam)
            (let ((pam-limits (pam-entry
                               (control "required")
                               (module "pam_limits.so")
-                              (arguments '("conf=/etc/security/limits.conf")))))
+                              (arguments
+                               '("conf=/etc/security/limits.conf")))))
              (if (member (pam-service-name pam)
                          '("login" "greetd" "su" "slim" "gdm-password" "sddm"
                            "sudo" "sshd"))
@@ -1602,7 +1578,27 @@ information on the configuration file syntax."
                   (inherit pam)
                   (session (cons pam-limits
                                  (pam-service-session pam))))
-                 pam)))))
+                 pam))))
+
+        ;; XXX: Using file-like objects is deprecated, use lists instead.
+        ;;      This is to be reduced into the list? case when the deprecated
+        ;;      code gets removed.
+        ;; Create /etc/security containing the provided "limits.conf" file.
+        (security-limits
+         (match-lambda
+           ((? file-like? obj)
+            (warning (G_ "Using file-like value for \
+'pam-limits-service-type' is deprecated~%"))
+            `(("security/limits.conf" ,obj)))
+           ((? list? lst)
+            `(("security/limits.conf"
+               ,(plain-file "limits.conf"
+                            (string-join (map pam-limits-entry->string lst)
+                                         "\n" 'suffix)))))
+           (_ (raise
+               (formatted-message
+                (G_ "invalid input for 'pam-limits-service-type'~%")))))))
+
     (service-type
      (name 'limits)
      (extensions
@@ -1612,9 +1608,11 @@ information on the configuration file syntax."
      (description
       "Install the specified resource usage limits by populating
 @file{/etc/security/limits.conf} and using the @code{pam_limits}
-authentication module."))))
+authentication module.")
+     (default-value '()))))
 
-(define* (pam-limits-service #:optional (limits '()))
+(define-deprecated (pam-limits-service #:optional (limits '()))
+  pam-limits-service-type
   "Return a service that makes selected programs respect the list of
 pam-limits-entry specified in LIMITS via pam_limits.so."
   (service pam-limits-service-type
@@ -1987,10 +1985,7 @@ proxy of 'guix-daemon'...~%")
               (default #f))
   (compression       guix-publish-configuration-compression
                      (thunked)
-                     (default (default-compression this-record
-                                (current-source-location))))
-  (compression-level %guix-publish-configuration-compression-level ;deprecated
-                     (default #f))
+                     (default (default-compression this-record)))
   (nar-path    guix-publish-configuration-nar-path ;string
                (default "nar"))
   (cache       guix-publish-configuration-cache   ;#f | string
@@ -2004,25 +1999,14 @@ proxy of 'guix-daemon'...~%")
   (negative-ttl guix-publish-configuration-negative-ttl ;#f | integer
                 (default #f)))
 
-(define-deprecated (guix-publish-configuration-compression-level config)
-  "Return a compression level, the old way."
-  (match (guix-publish-configuration-compression config)
-    (((_ level) _ ...) level)))
-
-(define (default-compression config properties)
+(define (default-compression config)
   "Return the default 'guix publish' compression according to CONFIG, and
 raise a deprecation warning if the 'compression-level' field was used."
-  (match (%guix-publish-configuration-compression-level config)
-    (#f
-     ;; 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)
-     `(("gzip" ,level)))))
+  ;; 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
 
 (define (guix-publish-shepherd-service config)
   (define (config->compression-options config)
@@ -2664,16 +2648,17 @@ Write, say, @samp{\"~a/24\"} for a 24-bit network mask.")
                             ipv6-address?))))
   (gateway     network-route-gateway (default #f)))
 
-(define* (cidr->netmask str #:optional (family AF_INET))
-  "Given @var{str}, a string in CIDR notation (e.g., \"1.2.3.4/24\"), return
+(eval-when (expand load eval)
+  (define* (cidr->netmask str #:optional (family AF_INET))
+    "Given @var{str}, a string in CIDR notation (e.g., \"1.2.3.4/24\"), return
 the netmask as a string like \"255.255.255.0\"."
-  (match (string-split str #\/)
-    ((ip (= string->number bits))
-     (let ((mask (ash (- (expt 2 bits) 1)
-                      (- (if (= family AF_INET6) 128 32)
-                         bits))))
-       (inet-ntop family mask)))
-    (_ #f)))
+    (match (string-split str #\/)
+      ((ip (= string->number bits))
+       (let ((mask (ash (- (expt 2 bits) 1)
+                        (- (if (= family AF_INET6) 128 32)
+                           bits))))
+         (inet-ntop family mask)))
+      (_ #f))))
 
 (define (cidr->ip str)
   "Strip the netmask bit of @var{str}, a CIDR-notation IP/netmask address."