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