Remove traces of "GuixSD".
[jackhill/guix/guix.git] / gnu / services / base.scm
index 6e99cbf..04b123b 100644 (file)
@@ -7,6 +7,7 @@
 ;;; Copyright © 2016 David Craven <david@craven.ch>
 ;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2019 Efraim Flashner <efraim@flashner.co.il>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -42,6 +43,7 @@
                 #:select (canonical-package glibc glibc-utf8-locales))
   #:use-module (gnu packages bash)
   #:use-module (gnu packages package-management)
+  #:use-module ((gnu packages gnupg) #:select (guile-gcrypt))
   #:use-module (gnu packages linux)
   #:use-module (gnu packages terminals)
   #:use-module ((gnu build file-systems)
@@ -49,6 +51,7 @@
   #:use-module (guix gexp)
   #:use-module (guix records)
   #:use-module (guix modules)
+  #:use-module ((guix self) #:select (make-config.scm))
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 match)
@@ -328,7 +331,7 @@ seconds after @code{SIGTERM} has been sent are terminated with
   `(("fstab" ,(plain-file "fstab"
                           (string-append
                            "\
-# This file was generated from your GuixSD configuration.  Any changes
+# This file was generated from your Guix configuration.  Any changes
 # will be lost upon reboot or reconfiguration.\n\n"
                            (string-join (map file-system->fstab-entry
                                              file-systems)
@@ -818,6 +821,7 @@ Return a service that sets up Unicode support in @var{tty} and loads
   (service-type (name 'login)
                 (extensions (list (service-extension pam-root-service-type
                                                      login-pam-service)))
+                (default-value (login-configuration))
                 (description
                  "Provide a console log-in service as specified by its
 configuration value, a @code{login-configuration} object.")))
@@ -1358,6 +1362,7 @@ the tty to run, among other things."
                            (name-services (append
                                            (nscd-configuration-name-services config)
                                            name-services)))))
+                (default-value %nscd-default-configuration)
                 (description
                  "Runs libc's @dfn{name service cache daemon} (nscd) with the
 given configuration---an @code{<nscd-configuration>} object.  @xref{Name
@@ -1478,16 +1483,14 @@ pam-limits-entry specified in LIMITS via pam_limits.so."
 
 (define* (guix-build-accounts count #:key
                               (group "guixbuild")
-                              (first-uid 30001)
                               (shadow shadow))
-  "Return a list of COUNT user accounts for Guix build users, with UIDs
-starting at FIRST-UID, and under GID."
+  "Return a list of COUNT user accounts for Guix build users with the given
+GID."
   (unfold (cut > <> count)
           (lambda (n)
             (user-account
              (name (format #f "guixbuilder~2,'0d" n))
              (system? #t)
-             (uid (+ first-uid n -1))
              (group group)
 
              ;; guix-daemon expects GROUP to be listed as a
@@ -1501,27 +1504,58 @@ starting at FIRST-UID, and under GID."
           1+
           1))
 
+(define not-config?
+  ;; Select (guix …) and (gnu …) modules, except (guix config).
+  (match-lambda
+    (('guix 'config) #f)
+    (('guix rest ...) #t)
+    (('gnu rest ...) #t)
+    (rest #f)))
+
 (define (hydra-key-authorization keys guix)
   "Return a gexp with code to register KEYS, a list of files containing 'guix
 archive' public keys, with GUIX."
-  #~(unless (file-exists? "/etc/guix/acl")
-      (for-each (lambda (key)
-                  (let ((pid (primitive-fork)))
-                    (case pid
-                      ((0)
-                       (let* ((port (open-file key "r0b")))
-                         (format #t "registering public key '~a'...~%" key)
-                         (close-port (current-input-port))
-                         (dup port 0)
-                         (execl #$(file-append guix "/bin/guix")
-                                "guix" "archive" "--authorize")
-                         (primitive-exit 1)))
-                      (else
-                       (let ((status (cdr (waitpid pid))))
-                         (unless (zero? status)
-                           (format (current-error-port) "warning: \
-failed to register public key '~a': ~a~%" key status)))))))
-                '(#$@keys))))
+  (define aaa
+    ;; XXX: Terrible hack to work around <https://bugs.gnu.org/15602>: this
+    ;; forces (guix config) and (guix utils) to be loaded upfront, so that
+    ;; their run-time symbols are defined.
+    (scheme-file "aaa.scm"
+                 #~(define-module (guix aaa)
+                     #:use-module (guix config)
+                     #:use-module (guix memoization))))
+
+  (define default-acl
+    (with-extensions (list guile-gcrypt)
+      (with-imported-modules `(((guix config) => ,(make-config.scm))
+                               ((guix aaa) => ,aaa)
+                               ,@(source-module-closure '((guix pki))
+                                                        #:select? not-config?))
+        (computed-file "acl"
+                       #~(begin
+                           (use-modules (guix pki)
+                                        (gcrypt pk-crypto)
+                                        (ice-9 rdelim))
+
+                           (define keys
+                             (map (lambda (file)
+                                    (call-with-input-file file
+                                      (compose string->canonical-sexp
+                                               read-string)))
+                                  '(#$@keys)))
+
+                           (call-with-output-file #$output
+                             (lambda (port)
+                               (write-acl (public-keys->acl keys)
+                                          port))))))))
+
+  (with-imported-modules '((guix build utils))
+    #~(begin
+        (use-modules (guix build utils))
+
+        (unless (file-exists? "/etc/guix/acl")
+          (mkdir-p "/etc/guix")
+          (copy-file #+default-acl "/etc/guix/acl")
+          (chmod "/etc/guix/acl" #o600)))))
 
 (define %default-authorized-guix-keys
   ;; List of authorized substitute keys.
@@ -1688,7 +1722,9 @@ failed to register public key '~a': ~a~%" key status)))))))
    (description
     "Run the build daemon of GNU@tie{}Guix, aka. @command{guix-daemon}.")))
 
-(define* (guix-service #:optional (config %default-guix-configuration))
+(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))
@@ -1789,7 +1825,9 @@ failed to register public key '~a': ~a~%" key status)))))))
                  "Add a Shepherd service running @command{guix publish}, a
 command that allows you to share pre-built binaries with others over HTTP.")))
 
-(define* (guix-publish-service #:key (guix guix) (port 80) (host "localhost"))
+(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}).
 
@@ -1809,7 +1847,7 @@ archive}).  If that is not the case, the service will fail to start."
   udev-configuration make-udev-configuration
   udev-configuration?
   (udev   udev-configuration-udev                 ;<package>
-          (default udev))
+          (default eudev))
   (rules  udev-configuration-rules                ;list of <package>
           (default '())))
 
@@ -1992,6 +2030,7 @@ the udev rules in use.")
                              (udev-configuration
                               (udev udev)
                               (rules (append initial-rules rules)))))))
+                (default-value (udev-configuration))
                 (description
                  "Run @command{udev}, which populates the @file{/dev}
 directory dynamically.  Get extra rules from the packages listed in the
@@ -2134,7 +2173,7 @@ This service is not part of @var{%base-services}."
 
        (shepherd-service
         (documentation "kmscon virtual terminal")
-        (requirement '(user-processes udev dbus-system virtual-terminal))
+        (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)))))))
@@ -2289,7 +2328,7 @@ to handle."
 \f
 (define %base-services
   ;; Convenience variable holding the basic services.
-  (list (login-service)
+  (list (service login-service-type)
 
         (service virtual-terminal-service-type)
         (service console-font-service-type
@@ -2297,23 +2336,23 @@ to handle."
                         (cons tty %default-console-font))
                       '("tty1" "tty2" "tty3" "tty4" "tty5" "tty6")))
 
-        (agetty-service (agetty-configuration
-                         (extra-options '("-L")) ; no carrier detect
-                         (term "vt100")
-                         (tty #f))) ; automatic
-
-        (mingetty-service (mingetty-configuration
-                           (tty "tty1")))
-        (mingetty-service (mingetty-configuration
-                           (tty "tty2")))
-        (mingetty-service (mingetty-configuration
-                           (tty "tty3")))
-        (mingetty-service (mingetty-configuration
-                           (tty "tty4")))
-        (mingetty-service (mingetty-configuration
-                           (tty "tty5")))
-        (mingetty-service (mingetty-configuration
-                           (tty "tty6")))
+        (service agetty-service-type (agetty-configuration
+                                       (extra-options '("-L")) ; no carrier detect
+                                       (term "vt100")
+                                       (tty #f))) ; automatic
+
+        (service mingetty-service-type (mingetty-configuration
+                                         (tty "tty1")))
+        (service mingetty-service-type (mingetty-configuration
+                                         (tty "tty2")))
+        (service mingetty-service-type (mingetty-configuration
+                                         (tty "tty3")))
+        (service mingetty-service-type (mingetty-configuration
+                                         (tty "tty4")))
+        (service mingetty-service-type (mingetty-configuration
+                                         (tty "tty5")))
+        (service mingetty-service-type (mingetty-configuration
+                                         (tty "tty6")))
 
         (service static-networking-service-type
                  (list (static-networking (interface "lo")
@@ -2322,13 +2361,15 @@ to handle."
                                           (provision '(loopback)))))
         (syslog-service)
         (service urandom-seed-service-type)
-        (guix-service)
-        (nscd-service)
+        (service guix-service-type)
+        (service nscd-service-type)
 
         ;; The LVM2 rules are needed as soon as LVM2 or the device-mapper is
         ;; used, so enable them by default.  The FUSE and ALSA rules are
         ;; less critical, but handy.
-        (udev-service #:rules (list lvm2 fuse alsa-utils crda))
+        (service udev-service-type
+                 (udev-configuration
+                   (rules (list lvm2 fuse alsa-utils crda))))
 
         (service special-files-service-type
                  `(("/bin/sh" ,(file-append (canonical-package bash)