gnu/services/base.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
   3 ;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com>
   4 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
   5 ;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
   6 ;;;
   7 ;;; This file is part of GNU Guix.
   8 ;;;
   9 ;;; GNU Guix is free software; you can redistribute it and/or modify it
  10 ;;; under the terms of the GNU General Public License as published by
  11 ;;; the Free Software Foundation; either version 3 of the License, or (at
  12 ;;; your option) any later version.
  13 ;;;
  14 ;;; GNU Guix is distributed in the hope that it will be useful, but
  15 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;;; GNU General Public License for more details.
  18 ;;;
  19 ;;; You should have received a copy of the GNU General Public License
  20 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 (define-module (gnu services base)
  23   #:use-module (guix store)
  24   #:use-module (gnu services)
  25   #:use-module (gnu services shepherd)
  26   #:use-module (gnu services networking)
  27   #:use-module (gnu system pam)
  28   #:use-module (gnu system shadow)                ; 'user-account', etc.
  29   #:use-module (gnu system file-systems)          ; 'file-system', etc.
  30   #:use-module (gnu packages admin)
  31   #:use-module ((gnu packages linux)
  32                 #:select (eudev kbd e2fsprogs lvm2 fuse alsa-utils crda gpm))
  33   #:use-module ((gnu packages base)
  34                 #:select (canonical-package glibc))
  35   #:use-module (gnu packages package-management)
  36   #:use-module (gnu packages lsh)
  37   #:use-module (gnu packages lsof)
  38   #:use-module ((gnu build file-systems)
  39                 #:select (mount-flags->bit-mask))
  40   #:use-module (guix gexp)
  41   #:use-module (guix records)
  42   #:use-module (srfi srfi-1)
  43   #:use-module (srfi srfi-26)
  44   #:use-module (ice-9 match)
  45   #:use-module (ice-9 format)
  46   #:export (fstab-service-type
  47             root-file-system-service
  48             file-system-service
  49             user-unmount-service
  50             device-mapping-service
  51             swap-service
  52             user-processes-service
  53             session-environment-service
  54             session-environment-service-type
  55             host-name-service
  56             console-keymap-service
  57             console-font-service
  58
  59             udev-configuration
  60             udev-configuration?
  61             udev-configuration-rules
  62             udev-service-type
  63             udev-service
  64             udev-rule
  65
  66             mingetty-configuration
  67             mingetty-configuration?
  68             mingetty-service
  69             mingetty-service-type
  70
  71             %nscd-default-caches
  72             %nscd-default-configuration
  73
  74             nscd-configuration
  75             nscd-configuration?
  76
  77             nscd-cache
  78             nscd-cache?
  79
  80             nscd-service-type
  81             nscd-service
  82             syslog-service
  83
  84             guix-configuration
  85             guix-configuration?
  86             guix-service
  87             guix-service-type
  88             guix-publish-configuration
  89             guix-publish-configuration?
  90             guix-publish-service
  91             guix-publish-service-type
  92             gpm-service-type
  93             gpm-service
  94
  95             %base-services))
  96
  97 ;;; Commentary:
  98 ;;;
  99 ;;; Base system services---i.e., services that 99% of the users will want to
 100 ;;; use.
 101 ;;;
 102 ;;; Code:
 103
 104 \f
 105 ;;;
 106 ;;; File systems.
 107 ;;;
 108
 109 (define (file-system->fstab-entry file-system)
 110   "Return a @file{/etc/fstab} entry for @var{file-system}."
 111   (string-append (case (file-system-title file-system)
 112                    ((label)
 113                     (string-append "LABEL=" (file-system-device file-system)))
 114                    ((uuid)
 115                     (string-append
 116                      "UUID="
 117                      (uuid->string (file-system-device file-system))))
 118                    (else
 119                     (file-system-device file-system)))
 120                  "\t"
 121                  (file-system-mount-point file-system) "\t"
 122                  (file-system-type file-system) "\t"
 123                  (or (file-system-options file-system) "defaults") "\t"
 124
 125                  ;; XXX: Omit the 'fs_freq' and 'fs_passno' fields because we
 126                  ;; don't have anything sensible to put in there.
 127                  ))
 128
 129 (define (file-systems->fstab file-systems)
 130   "Return a @file{/etc} entry for an @file{fstab} describing
 131 @var{file-systems}."
 132   `(("fstab" ,(plain-file "fstab"
 133                           (string-append
 134                            "\
 135 # This file was generated from your GuixSD configuration.  Any changes
 136 # will be lost upon reboot or reconfiguration.\n\n"
 137                            (string-join (map file-system->fstab-entry
 138                                              file-systems)
 139                                         "\n")
 140                            "\n")))))
 141
 142 (define fstab-service-type
 143   ;; The /etc/fstab service.
 144   (service-type (name 'fstab)
 145                 (extensions
 146                  (list (service-extension etc-service-type
 147                                           file-systems->fstab)))
 148                 (compose identity)
 149                 (extend append)))
 150
 151 (define %root-file-system-shepherd-service
 152   (shepherd-service
 153    (documentation "Take care of the root file system.")
 154    (provision '(root-file-system))
 155    (start #~(const #t))
 156    (stop #~(lambda _
 157              ;; Return #f if successfully stopped.
 158              (sync)
 159
 160              (call-with-blocked-asyncs
 161               (lambda ()
 162                 (let ((null (%make-void-port "w")))
 163                   ;; Close 'shepherd.log'.
 164                   (display "closing log\n")
 165                   ((@ (shepherd comm) stop-logging))
 166
 167                   ;; Redirect the default output ports..
 168                   (set-current-output-port null)
 169                   (set-current-error-port null)
 170
 171                   ;; Close /dev/console.
 172                   (for-each close-fdes '(0 1 2))
 173
 174                   ;; At this point, there are no open files left, so the
 175                   ;; root file system can be re-mounted read-only.
 176                   (mount #f "/" #f
 177                          (logior MS_REMOUNT MS_RDONLY)
 178                          #:update-mtab? #f)
 179
 180                   #f)))))
 181    (respawn? #f)))
 182
 183 (define root-file-system-service-type
 184   (shepherd-service-type 'root-file-system
 185                          (const %root-file-system-shepherd-service)))
 186
 187 (define (root-file-system-service)
 188   "Return a service whose sole purpose is to re-mount read-only the root file
 189 system upon shutdown (aka. cleanly \"umounting\" root.)
 190
 191 This service must be the root of the service dependency graph so that its
 192 'stop' action is invoked when shepherd is the only process left."
 193   (service root-file-system-service-type #f))
 194
 195 (define (file-system->shepherd-service-name file-system)
 196   "Return the symbol that denotes the service mounting and unmounting
 197 FILE-SYSTEM."
 198   (symbol-append 'file-system-
 199                  (string->symbol (file-system-mount-point file-system))))
 200
 201 (define (mapped-device->shepherd-service-name md)
 202   "Return the symbol that denotes the shepherd service of MD, a <mapped-device>."
 203   (symbol-append 'device-mapping-
 204                  (string->symbol (mapped-device-target md))))
 205
 206 (define dependency->shepherd-service-name
 207   (match-lambda
 208     ((? mapped-device? md)
 209      (mapped-device->shepherd-service-name md))
 210     ((? file-system? fs)
 211      (file-system->shepherd-service-name fs))))
 212
 213 (define (file-system-shepherd-service file-system)
 214   "Return a list containing the shepherd service for @var{file-system}."
 215   (let ((target  (file-system-mount-point file-system))
 216         (device  (file-system-device file-system))
 217         (type    (file-system-type file-system))
 218         (title   (file-system-title file-system))
 219         (check?  (file-system-check? file-system))
 220         (create? (file-system-create-mount-point? file-system))
 221         (dependencies (file-system-dependencies file-system)))
 222     (if (file-system-mount? file-system)
 223         (list
 224          (shepherd-service
 225           (provision (list (file-system->shepherd-service-name file-system)))
 226           (requirement `(root-file-system
 227                          ,@(map dependency->shepherd-service-name dependencies)))
 228           (documentation "Check, mount, and unmount the given file system.")
 229           (start #~(lambda args
 230                      ;; FIXME: Use or factorize with 'mount-file-system'.
 231                      (let ((device (canonicalize-device-spec #$device '#$title))
 232                            (flags  #$(mount-flags->bit-mask
 233                                       (file-system-flags file-system))))
 234                        #$(if create?
 235                              #~(mkdir-p #$target)
 236                              #~#t)
 237                        #$(if check?
 238                              #~(begin
 239                                  ;; Make sure fsck.ext2 & co. can be found.
 240                                  (setenv "PATH"
 241                                          (string-append
 242                                           #$e2fsprogs "/sbin:"
 243                                           "/run/current-system/profile/sbin:"
 244                                           (getenv "PATH")))
 245                                  (check-file-system device #$type))
 246                              #~#t)
 247
 248                        (mount device #$target #$type flags
 249                               #$(file-system-options file-system))
 250
 251                        ;; For read-only bind mounts, an extra remount is
 252                        ;; needed, as per <http://lwn.net/Articles/281157/>,
 253                        ;; which still applies to Linux 4.0.
 254                        (when (and (= MS_BIND (logand flags MS_BIND))
 255                                   (= MS_RDONLY (logand flags MS_RDONLY)))
 256                          (mount device #$target #$type
 257                                 (logior MS_BIND MS_REMOUNT MS_RDONLY))))
 258                      #t))
 259           (stop #~(lambda args
 260                     ;; Normally there are no processes left at this point, so
 261                     ;; TARGET can be safely unmounted.
 262
 263                     ;; Make sure PID 1 doesn't keep TARGET busy.
 264                     (chdir "/")
 265
 266                     (umount #$target)
 267                     #f))
 268
 269           ;; We need an additional module.
 270           (modules `(((gnu build file-systems)
 271                       #:select (check-file-system canonicalize-device-spec))
 272                      ,@%default-modules))
 273           (imported-modules `((gnu build file-systems)
 274                               ,@%default-imported-modules))))
 275         '())))
 276
 277 (define file-system-service-type
 278   ;; TODO(?): Make this an extensible service that takes <file-system> objects
 279   ;; and returns a list of <shepherd-service>.
 280   (service-type (name 'file-system)
 281                 (extensions
 282                  (list (service-extension shepherd-root-service-type
 283                                           file-system-shepherd-service)
 284                        (service-extension fstab-service-type
 285                                           identity)))))
 286
 287 (define* (file-system-service file-system)
 288   "Return a service that mounts @var{file-system}, a @code{<file-system>}
 289 object."
 290   (service file-system-service-type file-system))
 291
 292 (define user-unmount-service-type
 293   (shepherd-service-type
 294    'user-file-systems
 295    (lambda (known-mount-points)
 296      (shepherd-service
 297       (documentation "Unmount manually-mounted file systems.")
 298       (provision '(user-file-systems))
 299       (start #~(const #t))
 300       (stop #~(lambda args
 301                 (define (known? mount-point)
 302                   (member mount-point
 303                           (cons* "/proc" "/sys" '#$known-mount-points)))
 304
 305                 ;; Make sure we don't keep the user's mount points busy.
 306                 (chdir "/")
 307
 308                 (for-each (lambda (mount-point)
 309                             (format #t "unmounting '~a'...~%" mount-point)
 310                             (catch 'system-error
 311                               (lambda ()
 312                                 (umount mount-point))
 313                               (lambda args
 314                                 (let ((errno (system-error-errno args)))
 315                                   (format #t "failed to unmount '~a': ~a~%"
 316                                           mount-point (strerror errno))))))
 317                           (filter (negate known?) (mount-points)))
 318                 #f))))))
 319
 320 (define (user-unmount-service known-mount-points)
 321   "Return a service whose sole purpose is to unmount file systems not listed
 322 in KNOWN-MOUNT-POINTS when it is stopped."
 323   (service user-unmount-service-type known-mount-points))
 324
 325 (define %do-not-kill-file
 326   ;; Name of the file listing PIDs of processes that must survive when halting
 327   ;; the system.  Typical example is user-space file systems.
 328   "/etc/shepherd/do-not-kill")
 329
 330 (define user-processes-service-type
 331   (shepherd-service-type
 332    'user-processes
 333    (match-lambda
 334      ((requirements grace-delay)
 335       (shepherd-service
 336        (documentation "When stopped, terminate all user processes.")
 337        (provision '(user-processes))
 338        (requirement (cons* 'root-file-system 'user-file-systems
 339                            (map file-system->shepherd-service-name
 340                                 requirements)))
 341        (start #~(const #t))
 342        (stop #~(lambda _
 343                  (define (kill-except omit signal)
 344                    ;; Kill all the processes with SIGNAL except those listed
 345                    ;; in OMIT and the current process.
 346                    (let ((omit (cons (getpid) omit)))
 347                      (for-each (lambda (pid)
 348                                  (unless (memv pid omit)
 349                                    (false-if-exception
 350                                     (kill pid signal))))
 351                                (processes))))
 352
 353                  (define omitted-pids
 354                    ;; List of PIDs that must not be killed.
 355                    (if (file-exists? #$%do-not-kill-file)
 356                        (map string->number
 357                             (call-with-input-file #$%do-not-kill-file
 358                               (compose string-tokenize
 359                                        (@ (ice-9 rdelim) read-string))))
 360                        '()))
 361
 362                  (define (now)
 363                    (car (gettimeofday)))
 364
 365                  (define (sleep* n)
 366                    ;; Really sleep N seconds.
 367                    ;; Work around <http://bugs.gnu.org/19581>.
 368                    (define start (now))
 369                    (let loop ((elapsed 0))
 370                      (when (> n elapsed)
 371                        (sleep (- n elapsed))
 372                        (loop (- (now) start)))))
 373
 374                  (define lset= (@ (srfi srfi-1) lset=))
 375
 376                  (display "sending all processes the TERM signal\n")
 377
 378                  (if (null? omitted-pids)
 379                      (begin
 380                        ;; Easy: terminate all of them.
 381                        (kill -1 SIGTERM)
 382                        (sleep* #$grace-delay)
 383                        (kill -1 SIGKILL))
 384                      (begin
 385                        ;; Kill them all except OMITTED-PIDS.  XXX: We would
 386                        ;; like to (kill -1 SIGSTOP) to get a fixed list of
 387                        ;; processes, like 'killall5' does, but that seems
 388                        ;; unreliable.
 389                        (kill-except omitted-pids SIGTERM)
 390                        (sleep* #$grace-delay)
 391                        (kill-except omitted-pids SIGKILL)
 392                        (delete-file #$%do-not-kill-file)))
 393
 394                  (let wait ()
 395                    (let ((pids (processes)))
 396                      (unless (lset= = pids (cons 1 omitted-pids))
 397                        (format #t "waiting for process termination\
 398  (processes left: ~s)~%"
 399                                pids)
 400                        (sleep* 2)
 401                        (wait))))
 402
 403                  (display "all processes have been terminated\n")
 404                  #f))
 405        (respawn? #f))))))
 406
 407 (define* (user-processes-service file-systems #:key (grace-delay 4))
 408   "Return the service that is responsible for terminating all the processes so
 409 that the root file system can be re-mounted read-only, just before
 410 rebooting/halting.  Processes still running GRACE-DELAY seconds after SIGTERM
 411 has been sent are terminated with SIGKILL.
 412
 413 The returned service will depend on 'root-file-system' and on all the shepherd
 414 services corresponding to FILE-SYSTEMS.
 415
 416 All the services that spawn processes must depend on this one so that they are
 417 stopped before 'kill' is called."
 418   (service user-processes-service-type
 419            (list (filter file-system-mount? file-systems) grace-delay)))
 420
 421 \f
 422 ;;;
 423 ;;; System-wide environment variables.
 424 ;;;
 425
 426 (define (environment-variables->environment-file vars)
 427   "Return a file for pam_env(8) that contains environment variables VARS."
 428   (apply mixed-text-file "environment"
 429          (append-map (match-lambda
 430                        ((key . value)
 431                         (list key "=" value "\n")))
 432                      vars)))
 433
 434 (define session-environment-service-type
 435   (service-type
 436    (name 'session-environment)
 437    (extensions
 438     (list (service-extension
 439            etc-service-type
 440            (lambda (vars)
 441              (list `("environment"
 442                      ,(environment-variables->environment-file vars)))))))
 443    (compose concatenate)
 444    (extend append)))
 445
 446 (define (session-environment-service vars)
 447   "Return a service that builds the @file{/etc/environment}, which can be read
 448 by PAM-aware applications to set environment variables for sessions.
 449
 450 VARS should be an association list in which both the keys and the values are
 451 strings or string-valued gexps."
 452   (service session-environment-service-type vars))
 453
 454 \f
 455 ;;;
 456 ;;; Console & co.
 457 ;;;
 458
 459 (define host-name-service-type
 460   (shepherd-service-type
 461    'host-name
 462    (lambda (name)
 463      (shepherd-service
 464       (documentation "Initialize the machine's host name.")
 465       (provision '(host-name))
 466       (start #~(lambda _
 467                  (sethostname #$name)))
 468       (respawn? #f)))))
 469
 470 (define (host-name-service name)
 471   "Return a service that sets the host name to @var{name}."
 472   (service host-name-service-type name))
 473
 474 (define (unicode-start tty)
 475   "Return a gexp to start Unicode support on @var{tty}."
 476
 477   ;; We have to run 'unicode_start' in a pipe so that when it invokes the
 478   ;; 'tty' command, that command returns TTY.
 479   #~(begin
 480       (let ((pid (primitive-fork)))
 481         (case pid
 482           ((0)
 483            (close-fdes 0)
 484            (dup2 (open-fdes #$tty O_RDONLY) 0)
 485            (close-fdes 1)
 486            (dup2 (open-fdes #$tty O_WRONLY) 1)
 487            (execl (string-append #$kbd "/bin/unicode_start")
 488                   "unicode_start"))
 489           (else
 490            (zero? (cdr (waitpid pid))))))))
 491
 492 (define console-keymap-service-type
 493   (shepherd-service-type
 494    'console-keymap
 495    (lambda (file)
 496      (shepherd-service
 497       (documentation (string-append "Load console keymap (loadkeys)."))
 498       (provision '(console-keymap))
 499       (start #~(lambda _
 500                  (zero? (system* (string-append #$kbd "/bin/loadkeys")
 501                                  #$file))))
 502       (respawn? #f)))))
 503
 504 (define (console-keymap-service file)
 505   "Return a service to load console keymap from @var{file}."
 506   (service console-keymap-service-type file))
 507
 508 (define console-font-service-type
 509   (shepherd-service-type
 510    'console-font
 511    (match-lambda
 512      ((tty font)
 513       (let ((device (string-append "/dev/" tty)))
 514         (shepherd-service
 515          (documentation "Load a Unicode console font.")
 516          (provision (list (symbol-append 'console-font-
 517                                          (string->symbol tty))))
 518
 519          ;; Start after mingetty has been started on TTY, otherwise the settings
 520          ;; are ignored.
 521          (requirement (list (symbol-append 'term-
 522                                            (string->symbol tty))))
 523
 524          (start #~(lambda _
 525                     (and #$(unicode-start device)
 526                          (zero?
 527                           (system* (string-append #$kbd "/bin/setfont")
 528                                    "-C" #$device #$font)))))
 529          (stop #~(const #t))
 530          (respawn? #f)))))))
 531
 532 (define* (console-font-service tty #:optional (font "LatGrkCyr-8x16"))
 533   "Return a service that sets up Unicode support in @var{tty} and loads
 534 @var{font} for that tty (fonts are per virtual console in Linux.)"
 535   ;; Note: 'LatGrkCyr-8x16' has the advantage of providing three common
 536   ;; scripts as well as glyphs for em dash, quotation marks, and other Unicode
 537   ;; codepoints notably found in the UTF-8 manual.
 538   (service console-font-service-type (list tty font)))
 539
 540 (define-record-type* <mingetty-configuration>
 541   mingetty-configuration make-mingetty-configuration
 542   mingetty-configuration?
 543   (mingetty       mingetty-configuration-mingetty ;<package>
 544                   (default mingetty))
 545   (tty            mingetty-configuration-tty)     ;string
 546   (motd           mingetty-configuration-motd     ;file-like
 547                   (default (plain-file "motd" "Welcome.\n")))
 548   (auto-login     mingetty-auto-login             ;string | #f
 549                   (default #f))
 550   (login-program  mingetty-login-program          ;gexp
 551                   (default #f))
 552   (login-pause?   mingetty-login-pause?           ;Boolean
 553                   (default #f))
 554
 555   ;; Allow empty passwords by default so that first-time users can log in when
 556   ;; the 'root' account has just been created.
 557   (allow-empty-passwords? mingetty-configuration-allow-empty-passwords?
 558                           (default #t)))          ;Boolean
 559
 560 (define (mingetty-pam-service conf)
 561   "Return the list of PAM service needed for CONF."
 562   ;; Let 'login' be known to PAM.  All the mingetty services will have that
 563   ;; PAM service, but that's fine because they're all identical and duplicates
 564   ;; are removed.
 565   (list (unix-pam-service "login"
 566                           #:allow-empty-passwords?
 567                           (mingetty-configuration-allow-empty-passwords? conf)
 568                           #:motd
 569                           (mingetty-configuration-motd conf))))
 570
 571 (define mingetty-shepherd-service
 572   (match-lambda
 573     (($ <mingetty-configuration> mingetty tty motd auto-login login-program
 574                                  login-pause? allow-empty-passwords?)
 575      (list
 576       (shepherd-service
 577        (documentation "Run mingetty on an tty.")
 578        (provision (list (symbol-append 'term- (string->symbol tty))))
 579
 580        ;; Since the login prompt shows the host name, wait for the 'host-name'
 581        ;; service to be done.  Also wait for udev essentially so that the tty
 582        ;; text is not lost in the middle of kernel messages (XXX).
 583        (requirement '(user-processes host-name udev))
 584
 585        (start  #~(make-forkexec-constructor
 586                   (list (string-append #$mingetty "/sbin/mingetty")
 587                         "--noclear" #$tty
 588                         #$@(if auto-login
 589                                #~("--autologin" #$auto-login)
 590                                #~())
 591                         #$@(if login-program
 592                                #~("--loginprog" #$login-program)
 593                                #~())
 594                         #$@(if login-pause?
 595                                #~("--loginpause")
 596                                #~()))))
 597        (stop   #~(make-kill-destructor)))))))
 598
 599 (define mingetty-service-type
 600   (service-type (name 'mingetty)
 601                 (extensions (list (service-extension shepherd-root-service-type
 602                                                      mingetty-shepherd-service)
 603                                   (service-extension pam-root-service-type
 604                                                      mingetty-pam-service)))))
 605
 606 (define* (mingetty-service config)
 607   "Return a service to run mingetty according to @var{config}, which specifies
 608 the tty to run, among other things."
 609   (service mingetty-service-type config))
 610
 611 (define-record-type* <nscd-configuration> nscd-configuration
 612   make-nscd-configuration
 613   nscd-configuration?
 614   (log-file    nscd-configuration-log-file        ;string
 615                (default "/var/log/nscd.log"))
 616   (debug-level nscd-debug-level                   ;integer
 617                (default 0))
 618   ;; TODO: See nscd.conf in glibc for other options to add.
 619   (caches     nscd-configuration-caches           ;list of <nscd-cache>
 620               (default %nscd-default-caches))
 621   (name-services nscd-configuration-name-services ;list of <packages>
 622                  (default '()))
 623   (glibc      nscd-configuration-glibc            ;<package>
 624               (default (canonical-package glibc))))
 625
 626 (define-record-type* <nscd-cache> nscd-cache make-nscd-cache
 627   nscd-cache?
 628   (database              nscd-cache-database)              ;symbol
 629   (positive-time-to-live nscd-cache-positive-time-to-live) ;integer
 630   (negative-time-to-live nscd-cache-negative-time-to-live
 631                          (default 20))             ;integer
 632   (suggested-size        nscd-cache-suggested-size ;integer ("default module
 633                                                    ;of hash table")
 634                          (default 211))
 635   (check-files?          nscd-cache-check-files?  ;Boolean
 636                          (default #t))
 637   (persistent?           nscd-cache-persistent?   ;Boolean
 638                          (default #t))
 639   (shared?               nscd-cache-shared?       ;Boolean
 640                          (default #t))
 641   (max-database-size     nscd-cache-max-database-size ;integer
 642                          (default (* 32 (expt 2 20))))
 643   (auto-propagate?       nscd-cache-auto-propagate? ;Boolean
 644                          (default #t)))
 645
 646 (define %nscd-default-caches
 647   ;; Caches that we want to enable by default.  Note that when providing an
 648   ;; empty nscd.conf, all caches are disabled.
 649   (list (nscd-cache (database 'hosts)
 650
 651                     ;; Aggressively cache the host name cache to improve
 652                     ;; privacy and resilience.
 653                     (positive-time-to-live (* 3600 12))
 654                     (negative-time-to-live 20)
 655                     (persistent? #t))
 656
 657         (nscd-cache (database 'services)
 658
 659                     ;; Services are unlikely to change, so we can be even more
 660                     ;; aggressive.
 661                     (positive-time-to-live (* 3600 24))
 662                     (negative-time-to-live 3600)
 663                     (check-files? #t)             ;check /etc/services changes
 664                     (persistent? #t))))
 665
 666 (define %nscd-default-configuration
 667   ;; Default nscd configuration.
 668   (nscd-configuration))
 669
 670 (define (nscd.conf-file config)
 671   "Return the @file{nscd.conf} configuration file for @var{config}, an
 672 @code{<nscd-configuration>} object."
 673   (define cache->config
 674     (match-lambda
 675       (($ <nscd-cache> (= symbol->string database)
 676                        positive-ttl negative-ttl size check-files?
 677                        persistent? shared? max-size propagate?)
 678        (string-append "\nenable-cache\t" database "\tyes\n"
 679
 680                       "positive-time-to-live\t" database "\t"
 681                       (number->string positive-ttl) "\n"
 682                       "negative-time-to-live\t" database "\t"
 683                       (number->string negative-ttl) "\n"
 684                       "suggested-size\t" database "\t"
 685                       (number->string size) "\n"
 686                       "check-files\t" database "\t"
 687                       (if check-files? "yes\n" "no\n")
 688                       "persistent\t" database "\t"
 689                       (if persistent? "yes\n" "no\n")
 690                       "shared\t" database "\t"
 691                       (if shared? "yes\n" "no\n")
 692                       "max-db-size\t" database "\t"
 693                       (number->string max-size) "\n"
 694                       "auto-propagate\t" database "\t"
 695                       (if propagate? "yes\n" "no\n")))))
 696
 697   (match config
 698     (($ <nscd-configuration> log-file debug-level caches)
 699      (plain-file "nscd.conf"
 700                  (string-append "\
 701 # Configuration of libc's name service cache daemon (nscd).\n\n"
 702                                 (if log-file
 703                                     (string-append "logfile\t" log-file)
 704                                     "")
 705                                 "\n"
 706                                 (if debug-level
 707                                     (string-append "debug-level\t"
 708                                                    (number->string debug-level))
 709                                     "")
 710                                 "\n"
 711                                 (string-concatenate
 712                                  (map cache->config caches)))))))
 713
 714 (define (nscd-shepherd-service config)
 715   "Return a shepherd service for CONFIG, an <nscd-configuration> object."
 716   (let ((nscd.conf     (nscd.conf-file config))
 717         (name-services (nscd-configuration-name-services config)))
 718     (list (shepherd-service
 719            (documentation "Run libc's name service cache daemon (nscd).")
 720            (provision '(nscd))
 721            (requirement '(user-processes))
 722            (start #~(make-forkexec-constructor
 723                      (list (string-append #$(nscd-configuration-glibc config)
 724                                           "/sbin/nscd")
 725                            "-f" #$nscd.conf "--foreground")
 726
 727                      #:environment-variables
 728                      (list (string-append "LD_LIBRARY_PATH="
 729                                           (string-join
 730                                            (map (lambda (dir)
 731                                                   (string-append dir "/lib"))
 732                                                 (list #$@name-services))
 733                                            ":")))))
 734            (stop #~(make-kill-destructor))
 735
 736            (respawn? #f)))))
 737
 738 (define nscd-activation
 739   ;; Actions to take before starting nscd.
 740   #~(begin
 741       (use-modules (guix build utils))
 742       (mkdir-p "/var/run/nscd")
 743       (mkdir-p "/var/db/nscd")))                  ;for the persistent cache
 744
 745 (define nscd-service-type
 746   (service-type (name 'nscd)
 747                 (extensions
 748                  (list (service-extension activation-service-type
 749                                           (const nscd-activation))
 750                        (service-extension shepherd-root-service-type
 751                                           nscd-shepherd-service)))
 752
 753                 ;; This can be extended by providing additional name services
 754                 ;; such as nss-mdns.
 755                 (compose concatenate)
 756                 (extend (lambda (config name-services)
 757                           (nscd-configuration
 758                            (inherit config)
 759                            (name-services (append
 760                                            (nscd-configuration-name-services config)
 761                                            name-services)))))))
 762
 763 (define* (nscd-service #:optional (config %nscd-default-configuration))
 764   "Return a service that runs libc's name service cache daemon (nscd) with the
 765 given @var{config}---an @code{<nscd-configuration>} object.  @xref{Name
 766 Service Switch}, for an example."
 767   (service nscd-service-type config))
 768
 769 (define syslog-service-type
 770   (shepherd-service-type
 771    'syslog
 772    (lambda (config-file)
 773      (shepherd-service
 774       (documentation "Run the syslog daemon (syslogd).")
 775       (provision '(syslogd))
 776       (requirement '(user-processes))
 777       (start #~(make-forkexec-constructor
 778                 (list (string-append #$inetutils "/libexec/syslogd")
 779                       "--no-detach" "--rcfile" #$config-file)))
 780       (stop #~(make-kill-destructor))))))
 781
 782 ;; Snippet adapted from the GNU inetutils manual.
 783 (define %default-syslog.conf
 784   (plain-file "syslog.conf" "
 785      # Log all error messages, authentication messages of
 786      # level notice or higher and anything of level err or
 787      # higher to the console.
 788      # Don't log private authentication messages!
 789      *.alert;auth.notice;authpriv.none       /dev/console
 790
 791      # Log anything (except mail) of level info or higher.
 792      # Don't log private authentication messages!
 793      *.info;mail.none;authpriv.none          /var/log/messages
 794
 795      # Same, in a different place.
 796      *.info;mail.none;authpriv.none          /dev/tty12
 797
 798      # The authpriv file has restricted access.
 799      authpriv.*                              /var/log/secure
 800
 801      # Log all the mail messages in one place.
 802      mail.*                                  /var/log/maillog
 803 "))
 804
 805 (define* (syslog-service #:key (config-file %default-syslog.conf))
 806   "Return a service that runs @code{syslogd}.
 807 If configuration file name @var{config-file} is not specified, use some
 808 reasonable default settings."
 809   (service syslog-service-type config-file))
 810
 811 \f
 812 ;;;
 813 ;;; Guix services.
 814 ;;;
 815
 816 (define* (guix-build-accounts count #:key
 817                               (group "guixbuild")
 818                               (first-uid 30001)
 819                               (shadow shadow))
 820   "Return a list of COUNT user accounts for Guix build users, with UIDs
 821 starting at FIRST-UID, and under GID."
 822   (unfold (cut > <> count)
 823           (lambda (n)
 824             (user-account
 825              (name (format #f "guixbuilder~2,'0d" n))
 826              (system? #t)
 827              (uid (+ first-uid n -1))
 828              (group group)
 829
 830              ;; guix-daemon expects GROUP to be listed as a
 831              ;; supplementary group too:
 832              ;; <http://lists.gnu.org/archive/html/bug-guix/2013-01/msg00239.html>.
 833              (supplementary-groups (list group "kvm"))
 834
 835              (comment (format #f "Guix Build User ~2d" n))
 836              (home-directory "/var/empty")
 837              (shell #~(string-append #$shadow "/sbin/nologin"))))
 838           1+
 839           1))
 840
 841 (define (hydra-key-authorization guix)
 842   "Return a gexp with code to register the hydra.gnu.org public key with
 843 GUIX."
 844   #~(unless (file-exists? "/etc/guix/acl")
 845       (let ((pid (primitive-fork)))
 846         (case pid
 847           ((0)
 848            (let* ((key  (string-append #$guix
 849                                        "/share/guix/hydra.gnu.org.pub"))
 850                   (port (open-file key "r0b")))
 851              (format #t "registering public key '~a'...~%" key)
 852              (close-port (current-input-port))
 853              (dup port 0)
 854              (execl (string-append #$guix "/bin/guix")
 855                     "guix" "archive" "--authorize")
 856              (exit 1)))
 857           (else
 858            (let ((status (cdr (waitpid pid))))
 859              (unless (zero? status)
 860                (format (current-error-port) "warning: \
 861 failed to register hydra.gnu.org public key: ~a~%" status))))))))
 862
 863 (define-record-type* <guix-configuration>
 864   guix-configuration make-guix-configuration
 865   guix-configuration?
 866   (guix             guix-configuration-guix       ;<package>
 867                     (default guix))
 868   (build-group      guix-configuration-build-group ;string
 869                     (default "guixbuild"))
 870   (build-accounts   guix-configuration-build-accounts ;integer
 871                     (default 10))
 872   (authorize-key?   guix-configuration-authorize-key? ;Boolean
 873                     (default #t))
 874   (use-substitutes? guix-configuration-use-substitutes? ;Boolean
 875                     (default #t))
 876   (substitute-urls  guix-configuration-substitute-urls ;list of strings
 877                     (default %default-substitute-urls))
 878   (extra-options    guix-configuration-extra-options ;list of strings
 879                     (default '()))
 880   (lsof             guix-configuration-lsof       ;<package>
 881                     (default lsof))
 882   (lsh              guix-configuration-lsh        ;<package>
 883                     (default lsh)))
 884
 885 (define %default-guix-configuration
 886   (guix-configuration))
 887
 888 (define (guix-shepherd-service config)
 889   "Return a <shepherd-service> for the Guix daemon service with CONFIG."
 890   (match config
 891     (($ <guix-configuration> guix build-group build-accounts authorize-key?
 892                              use-substitutes? substitute-urls extra-options
 893                              lsof lsh)
 894      (list (shepherd-service
 895             (documentation "Run the Guix daemon.")
 896             (provision '(guix-daemon))
 897             (requirement '(user-processes))
 898             (start
 899              #~(make-forkexec-constructor
 900                 (list (string-append #$guix "/bin/guix-daemon")
 901                       "--build-users-group" #$build-group
 902                       #$@(if use-substitutes?
 903                              '()
 904                              '("--no-substitutes"))
 905                       "--substitute-urls" #$(string-join substitute-urls)
 906                       #$@extra-options)
 907
 908                 ;; Add 'lsof' (for the GC) and 'lsh' (for offloading) to the
 909                 ;; daemon's $PATH.
 910                 #:environment-variables
 911                 (list (string-append "PATH=" #$lsof "/bin:" #$lsh "/bin"))))
 912             (stop #~(make-kill-destructor)))))))
 913
 914 (define (guix-accounts config)
 915   "Return the user accounts and user groups for CONFIG."
 916   (match config
 917     (($ <guix-configuration> _ build-group build-accounts)
 918      (cons (user-group
 919             (name build-group)
 920             (system? #t)
 921
 922             ;; Use a fixed GID so that we can create the store with the right
 923             ;; owner.
 924             (id 30000))
 925            (guix-build-accounts build-accounts
 926                                 #:group build-group)))))
 927
 928 (define (guix-activation config)
 929   "Return the activation gexp for CONFIG."
 930   (match config
 931     (($ <guix-configuration> guix build-group build-accounts authorize-key?)
 932      ;; Assume that the store has BUILD-GROUP as its group.  We could
 933      ;; otherwise call 'chown' here, but the problem is that on a COW unionfs,
 934      ;; chown leads to an entire copy of the tree, which is a bad idea.
 935
 936      ;; Optionally authorize hydra.gnu.org's key.
 937      (and authorize-key?
 938           (hydra-key-authorization guix)))))
 939
 940 (define guix-service-type
 941   (service-type
 942    (name 'guix)
 943    (extensions
 944     (list (service-extension shepherd-root-service-type guix-shepherd-service)
 945           (service-extension account-service-type guix-accounts)
 946           (service-extension activation-service-type guix-activation)
 947           (service-extension profile-service-type
 948                              (compose list guix-configuration-guix))))))
 949
 950 (define* (guix-service #:optional (config %default-guix-configuration))
 951   "Return a service that runs the Guix build daemon according to
 952 @var{config}."
 953   (service guix-service-type config))
 954
 955
 956 (define-record-type* <guix-publish-configuration>
 957   guix-publish-configuration make-guix-publish-configuration
 958   guix-publish-configuration?
 959   (guix    guix-publish-configuration-guix        ;package
 960            (default guix))
 961   (port    guix-publish-configuration-port        ;number
 962            (default 80))
 963   (host    guix-publish-configuration-host        ;string
 964            (default "localhost")))
 965
 966 (define guix-publish-shepherd-service
 967   (match-lambda
 968     (($ <guix-publish-configuration> guix port host)
 969      (list (shepherd-service
 970             (provision '(guix-publish))
 971             (requirement '(guix-daemon))
 972             (start #~(make-forkexec-constructor
 973                       (list (string-append #$guix "/bin/guix")
 974                             "publish" "-u" "guix-publish"
 975                             "-p" #$(number->string port)
 976                             (string-append "--listen=" #$host))))
 977             (stop #~(make-kill-destructor)))))))
 978
 979 (define %guix-publish-accounts
 980   (list (user-group (name "guix-publish") (system? #t))
 981         (user-account
 982          (name "guix-publish")
 983          (group "guix-publish")
 984          (system? #t)
 985          (comment "guix publish user")
 986          (home-directory "/var/empty")
 987          (shell #~(string-append #$shadow "/sbin/nologin")))))
 988
 989 (define guix-publish-service-type
 990   (service-type (name 'guix-publish)
 991                 (extensions
 992                  (list (service-extension shepherd-root-service-type
 993                                           guix-publish-shepherd-service)
 994                        (service-extension account-service-type
 995                                           (const %guix-publish-accounts))))))
 996
 997 (define* (guix-publish-service #:key (guix guix) (port 80) (host "localhost"))
 998   "Return a service that runs @command{guix publish} listening on @var{host}
 999 and @var{port} (@pxref{Invoking guix publish}).
1000
1001 This assumes that @file{/etc/guix} already contains a signing key pair as
1002 created by @command{guix archive --generate-key} (@pxref{Invoking guix
1003 archive}).  If that is not the case, the service will fail to start."
1004   (service guix-publish-service-type
1005            (guix-publish-configuration (guix guix) (port port) (host host))))
1006
1007 \f
1008 ;;;
1009 ;;; Udev.
1010 ;;;
1011
1012 (define-record-type* <udev-configuration>
1013   udev-configuration make-udev-configuration
1014   udev-configuration?
1015   (udev   udev-configuration-udev                 ;<package>
1016           (default udev))
1017   (rules  udev-configuration-rules                ;list of <package>
1018           (default '())))
1019
1020 (define (udev-rules-union packages)
1021   "Return the union of the @code{lib/udev/rules.d} directories found in each
1022 item of @var{packages}."
1023   (define build
1024     #~(begin
1025         (use-modules (guix build union)
1026                      (guix build utils)
1027                      (srfi srfi-1)
1028                      (srfi srfi-26))
1029
1030         (define %standard-locations
1031           '("/lib/udev/rules.d" "/libexec/udev/rules.d"))
1032
1033         (define (rules-sub-directory directory)
1034           ;; Return the sub-directory of DIRECTORY containing udev rules, or
1035           ;; #f if none was found.
1036           (find directory-exists?
1037                 (map (cut string-append directory <>) %standard-locations)))
1038
1039         (mkdir-p (string-append #$output "/lib/udev"))
1040         (union-build (string-append #$output "/lib/udev/rules.d")
1041                      (filter-map rules-sub-directory '#$packages))))
1042
1043   (computed-file "udev-rules" build
1044                  #:modules '((guix build union)
1045                              (guix build utils))))
1046
1047 (define (udev-rule file-name contents)
1048   "Return a directory with a udev rule file FILE-NAME containing CONTENTS."
1049   (computed-file file-name
1050                  #~(begin
1051                      (use-modules (guix build utils))
1052
1053                      (define rules.d
1054                        (string-append #$output "/lib/udev/rules.d"))
1055
1056                      (mkdir-p rules.d)
1057                      (call-with-output-file
1058                          (string-append rules.d "/" #$file-name)
1059                        (lambda (port)
1060                          (display #$contents port))))
1061                  #:modules '((guix build utils))))
1062
1063 (define kvm-udev-rule
1064   ;; Return a directory with a udev rule that changes the group of /dev/kvm to
1065   ;; "kvm" and makes it #o660.  Apparently QEMU-KVM used to ship this rule,
1066   ;; but now we have to add it by ourselves.
1067
1068   ;; Build users are part of the "kvm" group, so we can fearlessly make
1069   ;; /dev/kvm 660 (see <http://bugs.gnu.org/18994>, for background.)
1070   (udev-rule "90-kvm.rules"
1071              "KERNEL==\"kvm\", GROUP=\"kvm\", MODE=\"0660\"\n"))
1072
1073 (define udev-shepherd-service
1074   ;; Return a <shepherd-service> for UDEV with RULES.
1075   (match-lambda
1076     (($ <udev-configuration> udev rules)
1077      (let* ((rules     (udev-rules-union (cons* udev kvm-udev-rule rules)))
1078             (udev.conf (computed-file "udev.conf"
1079                                       #~(call-with-output-file #$output
1080                                           (lambda (port)
1081                                             (format port
1082                                                     "udev_rules=\"~a/lib/udev/rules.d\"\n"
1083                                                     #$rules))))))
1084        (list
1085         (shepherd-service
1086          (provision '(udev))
1087
1088          ;; Udev needs /dev to be a 'devtmpfs' mount so that new device nodes can
1089          ;; be added: see
1090          ;; <http://www.linuxfromscratch.org/lfs/view/development/chapter07/udev.html>.
1091          (requirement '(root-file-system))
1092
1093          (documentation "Populate the /dev directory, dynamically.")
1094          (start #~(lambda ()
1095                     (define find
1096                       (@ (srfi srfi-1) find))
1097
1098                     (define udevd
1099                       ;; Choose the right 'udevd'.
1100                       (find file-exists?
1101                             (map (lambda (suffix)
1102                                    (string-append #$udev suffix))
1103                                  '("/libexec/udev/udevd" ;udev
1104                                    "/sbin/udevd"))))     ;eudev
1105
1106                     (define (wait-for-udevd)
1107                       ;; Wait until someone's listening on udevd's control
1108                       ;; socket.
1109                       (let ((sock (socket AF_UNIX SOCK_SEQPACKET 0)))
1110                         (let try ()
1111                           (catch 'system-error
1112                             (lambda ()
1113                               (connect sock PF_UNIX "/run/udev/control")
1114                               (close-port sock))
1115                             (lambda args
1116                               (format #t "waiting for udevd...~%")
1117                               (usleep 500000)
1118                               (try))))))
1119
1120                     ;; Allow udev to find the modules.
1121                     (setenv "LINUX_MODULE_DIRECTORY"
1122                             "/run/booted-system/kernel/lib/modules")
1123
1124                     ;; The first one is for udev, the second one for eudev.
1125                     (setenv "UDEV_CONFIG_FILE" #$udev.conf)
1126                     (setenv "EUDEV_RULES_DIRECTORY"
1127                             (string-append #$rules "/lib/udev/rules.d"))
1128
1129                     (let ((pid (primitive-fork)))
1130                       (case pid
1131                         ((0)
1132                          (exec-command (list udevd)))
1133                         (else
1134                          ;; Wait until udevd is up and running.  This
1135                          ;; appears to be needed so that the events
1136                          ;; triggered below are actually handled.
1137                          (wait-for-udevd)
1138
1139                          ;; Trigger device node creation.
1140                          (system* (string-append #$udev "/bin/udevadm")
1141                                   "trigger" "--action=add")
1142
1143                          ;; Wait for things to settle down.
1144                          (system* (string-append #$udev "/bin/udevadm")
1145                                   "settle")
1146                          pid)))))
1147          (stop #~(make-kill-destructor))
1148
1149          ;; When halting the system, 'udev' is actually killed by
1150          ;; 'user-processes', i.e., before its own 'stop' method was called.
1151          ;; Thus, make sure it is not respawned.
1152          (respawn? #f)))))))
1153
1154 (define udev-service-type
1155   (service-type (name 'udev)
1156                 (extensions
1157                  (list (service-extension shepherd-root-service-type
1158                                           udev-shepherd-service)))
1159
1160                 (compose concatenate)           ;concatenate the list of rules
1161                 (extend (lambda (config rules)
1162                           (match config
1163                             (($ <udev-configuration> udev initial-rules)
1164                              (udev-configuration
1165                               (udev udev)
1166                               (rules (append initial-rules rules)))))))))
1167
1168 (define* (udev-service #:key (udev eudev) (rules '()))
1169   "Run @var{udev}, which populates the @file{/dev} directory dynamically.  Get
1170 extra rules from the packages listed in @var{rules}."
1171   (service udev-service-type
1172            (udev-configuration (udev udev) (rules rules))))
1173
1174 (define device-mapping-service-type
1175   (shepherd-service-type
1176    'device-mapping
1177    (match-lambda
1178      ((target open close)
1179       (shepherd-service
1180        (provision (list (symbol-append 'device-mapping- (string->symbol target))))
1181        (requirement '(udev))
1182        (documentation "Map a device node using Linux's device mapper.")
1183        (start #~(lambda () #$open))
1184        (stop #~(lambda _ (not #$close)))
1185        (respawn? #f))))))
1186
1187 (define (device-mapping-service target open close)
1188   "Return a service that maps device @var{target}, a string such as
1189 @code{\"home\"} (meaning @code{/dev/mapper/home}).  Evaluate @var{open}, a
1190 gexp, to open it, and evaluate @var{close} to close it."
1191   (service device-mapping-service-type
1192            (list target open close)))
1193
1194 (define swap-service-type
1195   (shepherd-service-type
1196    'swap
1197    (lambda (device)
1198      (define requirement
1199        (if (string-prefix? "/dev/mapper/" device)
1200            (list (symbol-append 'device-mapping-
1201                                 (string->symbol (basename device))))
1202            '()))
1203
1204      (shepherd-service
1205       (provision (list (symbol-append 'swap- (string->symbol device))))
1206       (requirement `(udev ,@requirement))
1207       (documentation "Enable the given swap device.")
1208       (start #~(lambda ()
1209                  (restart-on-EINTR (swapon #$device))
1210                  #t))
1211       (stop #~(lambda _
1212                 (restart-on-EINTR (swapoff #$device))
1213                 #f))
1214       (respawn? #f)))))
1215
1216 (define (swap-service device)
1217   "Return a service that uses @var{device} as a swap device."
1218   (service swap-service-type device))
1219
1220
1221 (define-record-type* <gpm-configuration>
1222   gpm-configuration make-gpm-configuration gpm-configuration?
1223   (gpm      gpm-configuration-gpm)                ;package
1224   (options  gpm-configuration-options))           ;list of strings
1225
1226 (define gpm-shepherd-service
1227   (match-lambda
1228     (($ <gpm-configuration> gpm options)
1229      (list (shepherd-service
1230             (requirement '(udev))
1231             (provision '(gpm))
1232             (start #~(lambda ()
1233                        ;; 'gpm' runs in the background and sets a PID file.
1234                        ;; Note that it requires running as "root".
1235                        (false-if-exception (delete-file "/var/run/gpm.pid"))
1236                        (fork+exec-command (list (string-append #$gpm "/sbin/gpm")
1237                                                 #$@options))
1238
1239                        ;; Wait for the PID file to appear; declare failure if
1240                        ;; it doesn't show up.
1241                        (let loop ((i 3))
1242                          (or (file-exists? "/var/run/gpm.pid")
1243                              (if (zero? i)
1244                                  #f
1245                                  (begin
1246                                    (sleep 1)
1247                                    (loop (1- i))))))))
1248
1249             (stop #~(lambda (_)
1250                       ;; Return #f if successfully stopped.
1251                       (not (zero? (system* (string-append #$gpm "/sbin/gpm")
1252                                            "-k"))))))))))
1253
1254 (define gpm-service-type
1255   (service-type (name 'gpm)
1256                 (extensions
1257                  (list (service-extension shepherd-root-service-type
1258                                           gpm-shepherd-service)))))
1259
1260 (define* (gpm-service #:key (gpm gpm)
1261                       (options '("-m" "/dev/input/mice" "-t" "ps2")))
1262   "Run @var{gpm}, the general-purpose mouse daemon, with the given
1263 command-line @var{options}.  GPM allows users to use the mouse in the console,
1264 notably to select, copy, and paste text.  The default value of @var{options}
1265 uses the @code{ps2} protocol, which works for both USB and PS/2 mice.
1266
1267 This service is not part of @var{%base-services}."
1268   ;; To test in QEMU, use "-usbdevice mouse" and then, in the monitor, use
1269   ;; "info mice" and "mouse_set X" to use the right mouse.
1270   (service gpm-service-type
1271            (gpm-configuration (gpm gpm) (options options))))
1272
1273 \f
1274 (define %base-services
1275   ;; Convenience variable holding the basic services.
1276   (let ((motd (plain-file "motd" "
1277 This is the GNU operating system, welcome!\n\n")))
1278     (list (console-font-service "tty1")
1279           (console-font-service "tty2")
1280           (console-font-service "tty3")
1281           (console-font-service "tty4")
1282           (console-font-service "tty5")
1283           (console-font-service "tty6")
1284
1285           (mingetty-service (mingetty-configuration
1286                              (tty "tty1") (motd motd)))
1287           (mingetty-service (mingetty-configuration
1288                              (tty "tty2") (motd motd)))
1289           (mingetty-service (mingetty-configuration
1290                              (tty "tty3") (motd motd)))
1291           (mingetty-service (mingetty-configuration
1292                              (tty "tty4") (motd motd)))
1293           (mingetty-service (mingetty-configuration
1294                              (tty "tty5") (motd motd)))
1295           (mingetty-service (mingetty-configuration
1296                              (tty "tty6") (motd motd)))
1297
1298           (static-networking-service "lo" "127.0.0.1"
1299                                      #:provision '(loopback))
1300           (syslog-service)
1301           (guix-service)
1302           (nscd-service)
1303
1304           ;; The LVM2 rules are needed as soon as LVM2 or the device-mapper is
1305           ;; used, so enable them by default.  The FUSE and ALSA rules are
1306           ;; less critical, but handy.
1307           (udev-service #:rules (list lvm2 fuse alsa-utils crda)))))
1308
1309 ;;; base.scm ends here