[jackhill/guix/guix.git] / gnu / services / base.scm

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu services base)
  #:use-module (gnu services)
  #:use-module (gnu system shadow)                ; 'user-account', etc.
  #:use-module (gnu system linux)                 ; 'pam-service', etc.
  #:use-module (gnu packages admin)
  #:use-module ((gnu packages base)
                #:select (glibc-final))
  #:use-module (gnu packages package-management)
  #:use-module (guix gexp)
  #:use-module (guix monads)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:use-module (ice-9 format)
  #:export (root-file-system-service
            user-processes-service
            host-name-service
            mingetty-service
            nscd-service
            syslog-service
            guix-service
            %base-services))

;;; Commentary:
;;;
;;; Base system services---i.e., services that 99% of the users will want to
;;; use.
;;;
;;; Code:

(define (root-file-system-service)
  "Return a service whose sole purpose is to re-mount read-only the root file
system upon shutdown (aka. cleanly \"umounting\" root.)

This service must be the root of the service dependency graph so that its
'stop' action is invoked when dmd is the only process left."
  (with-monad %store-monad
    (return
     (service
      (documentation "Take care of the root file system.")
      (provision '(root-file-system))
      (start #~(const #t))
      (stop #~(lambda _
                ;; Return #f if successfully stopped.
                (sync)

                (call-with-blocked-asyncs
                 (lambda ()
                   (let ((null (%make-void-port "w")))
                     ;; Close 'dmd.log'.
                     (display "closing log\n")
                     ;; XXX: Ideally we'd use 'stop-logging', but that one
                     ;; doesn't actually close the port as of dmd 0.1.
                     (close-port (@@ (dmd comm) log-output-port))
                     (set! (@@ (dmd comm) log-output-port) null)

                     ;; Redirect the default output ports..
                     (set-current-output-port null)
                     (set-current-error-port null)

                     ;; Close /dev/console.
                     (for-each close-fdes '(0 1 2))

                     ;; At this point, there are no open files left, so the
                     ;; root file system can be re-mounted read-only.
                     (mount #f "/" #f
                            (logior MS_REMOUNT MS_RDONLY)
                            #:update-mtab? #f)

                     #f)))))
      (respawn? #f)))))

(define* (user-processes-service #:key (grace-delay 2))
  "Return the service that is responsible for terminating all the processes so
that the root file system can be re-mounted read-only, just before
rebooting/halting.  Processes still running GRACE-DELAY seconds after SIGTERM
has been sent are terminated with SIGKILL.

All the services that spawn processes must depend on this one so that they are
stopped before 'kill' is called."
  (with-monad %store-monad
    (return (service
             (documentation "When stopped, terminate all user processes.")
             (provision '(user-processes))
             (requirement '(root-file-system))
             (start #~(const #t))
             (stop #~(lambda _
                       ;; When this happens, all the processes have been
                       ;; killed, including 'deco', so DMD-OUTPUT-PORT and
                       ;; thus CURRENT-OUTPUT-PORT are dangling.
                       (call-with-output-file "/dev/console"
                         (lambda (port)
                           (display "sending all processes the TERM signal\n"
                                    port)))

                       (kill -1 SIGTERM)
                       (sleep #$grace-delay)
                       (kill -1 SIGKILL)

                       (display "all processes have been terminated\n")
                       #f))
             (respawn? #f)))))

(define (host-name-service name)
  "Return a service that sets the host name to NAME."
  (with-monad %store-monad
    (return (service
             (documentation "Initialize the machine's host name.")
             (provision '(host-name))
             (start #~(lambda _
                        (sethostname #$name)))
             (respawn? #f)))))

(define* (mingetty-service tty
                           #:key
                           (motd (text-file "motd" "Welcome.\n"))
                           (allow-empty-passwords? #t))
  "Return a service to run mingetty on TTY."
  (mlet %store-monad ((motd motd))
    (return
     (service
      (documentation (string-append "Run mingetty on " tty "."))
      (provision (list (symbol-append 'term- (string->symbol tty))))

      ;; Since the login prompt shows the host name, wait for the 'host-name'
      ;; service to be done.
      (requirement '(user-processes host-name))

      (start  #~(make-forkexec-constructor
                 (string-append #$mingetty "/sbin/mingetty")
                 "--noclear" #$tty))
      (stop   #~(make-kill-destructor))

      (pam-services
       ;; Let 'login' be known to PAM.  All the mingetty services will have
       ;; that PAM service, but that's fine because they're all identical and
       ;; duplicates are removed.
       (list (unix-pam-service "login"
                               #:allow-empty-passwords? allow-empty-passwords?
                               #:motd motd)))))))

(define* (nscd-service #:key (glibc glibc-final))
  "Return a service that runs libc's name service cache daemon (nscd)."
  (with-monad %store-monad
    (return (service
             (documentation "Run libc's name service cache daemon (nscd).")
             (provision '(nscd))
             (requirement '(user-processes))
             (start
              #~(make-forkexec-constructor (string-append #$glibc "/sbin/nscd")
                                           "-f" "/dev/null"
                                           "--foreground"))
             (stop #~(make-kill-destructor))

             (respawn? #f)))))

(define (syslog-service)
  "Return a service that runs 'syslogd' with reasonable default settings."

  ;; Snippet adapted from the GNU inetutils manual.
  (define contents "
     # Log all kernel messages, authentication messages of
     # level notice or higher and anything of level err or
     # higher to the console.
     # Don't log private authentication messages!
     *.err;kern.*;auth.notice;authpriv.none  /dev/console

     # Log anything (except mail) of level info or higher.
     # Don't log private authentication messages!
     *.info;mail.none;authpriv.none          /var/log/messages

     # Same, in a different place.
     *.info;mail.none;authpriv.none          /dev/tty12

     # The authpriv file has restricted access.
     authpriv.*                              /var/log/secure

     # Log all the mail messages in one place.
     mail.*                                  /var/log/maillog
")

  (mlet %store-monad
      ((syslog.conf (text-file "syslog.conf" contents)))
    (return
     (service
      (documentation "Run the syslog daemon (syslogd).")
      (provision '(syslogd))
      (requirement '(user-processes))
      (start
       #~(make-forkexec-constructor (string-append #$inetutils
                                                   "/libexec/syslogd")
                                    "--no-detach"
                                    "--rcfile" #$syslog.conf))
      (stop #~(make-kill-destructor))))))

(define* (guix-build-accounts count #:key
                              (first-uid 30001)
                              (gid 30000)
                              (shadow shadow))
  "Return a list of COUNT user accounts for Guix build users, with UIDs
starting at FIRST-UID, and under GID."
  (with-monad %store-monad
    (return (unfold (cut > <> count)
                    (lambda (n)
                      (user-account
                       (name (format #f "guixbuilder~2,'0d" n))
                       (password "!")
                       (uid (+ first-uid n -1))
                       (gid gid)
                       (comment (format #f "Guix Build User ~2d" n))
                       (home-directory "/var/empty")
                       (shell #~(string-append #$shadow "/sbin/nologin"))))
                    1+
                    1))))

(define* (guix-service #:key (guix guix) (builder-group "guixbuild")
                       (build-user-gid 30000) (build-accounts 10))
  "Return a service that runs the build daemon from GUIX, and has
BUILD-ACCOUNTS user accounts available under BUILD-USER-GID."
  (mlet %store-monad ((accounts (guix-build-accounts build-accounts
                                                     #:gid build-user-gid)))
    (return (service
             (provision '(guix-daemon))
             (requirement '(user-processes))
             (start
              #~(make-forkexec-constructor (string-append #$guix
                                                          "/bin/guix-daemon")
                                           "--build-users-group"
                                           #$builder-group))
             (stop #~(make-kill-destructor))
             (user-accounts accounts)
             (user-groups (list (user-group
                                 (name builder-group)
                                 (id build-user-gid)
                                 (members (map user-account-name
                                               user-accounts)))))))))

(define %base-services
  ;; Convenience variable holding the basic services.
  (let ((motd (text-file "motd" "
This is the GNU operating system, welcome!\n\n")))
    (list (mingetty-service "tty1" #:motd motd)
          (mingetty-service "tty2" #:motd motd)
          (mingetty-service "tty3" #:motd motd)
          (mingetty-service "tty4" #:motd motd)
          (mingetty-service "tty5" #:motd motd)
          (mingetty-service "tty6" #:motd motd)
          (syslog-service)
          (guix-service)
          (nscd-service))))

;;; base.scm ends here
Commit	Line	Data
db4fdc04 LC	1	;;; GNU Guix --- Functional package management for GNU
	2	;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
	3	;;;
	4	;;; This file is part of GNU Guix.
	5	;;;
	6	;;; GNU Guix is free software; you can redistribute it and/or modify it
	7	;;; under the terms of the GNU General Public License as published by
	8	;;; the Free Software Foundation; either version 3 of the License, or (at
	9	;;; your option) any later version.
	10	;;;
	11	;;; GNU Guix is distributed in the hope that it will be useful, but
	12	;;; WITHOUT ANY WARRANTY; without even the implied warranty of
	13	;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	14	;;; GNU General Public License for more details.
	15	;;;
	16	;;; You should have received a copy of the GNU General Public License
	17	;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
	18
	19	(define-module (gnu services base)
	20	#:use-module (gnu services)
	21	#:use-module (gnu system shadow) ; 'user-account', etc.
	22	#:use-module (gnu system linux) ; 'pam-service', etc.
	23	#:use-module (gnu packages admin)
	24	#:use-module ((gnu packages base)
23ed63a1	25	#:select (glibc-final))
db4fdc04	26	#:use-module (gnu packages package-management)
b5f4e686	27	#:use-module (guix gexp)
db4fdc04 LC	28	#:use-module (guix monads)
	29	#:use-module (srfi srfi-1)
	30	#:use-module (srfi srfi-26)
	31	#:use-module (ice-9 format)
a00dd9fb LC	32	#:export (root-file-system-service
	33	user-processes-service
	34	host-name-service
db4fdc04 LC	35	mingetty-service
	36	nscd-service
	37	syslog-service
8b198abe LC	38	guix-service
8b198abe LC	39	%base-services))
db4fdc04 LC	40
	41	;;; Commentary:
	42	;;;
	43	;;; Base system services---i.e., services that 99% of the users will want to
	44	;;; use.
	45	;;;
	46	;;; Code:
	47
a00dd9fb LC	48	(define (root-file-system-service)
	49	"Return a service whose sole purpose is to re-mount read-only the root file
	50	system upon shutdown (aka. cleanly \"umounting\" root.)
	51
	52	This service must be the root of the service dependency graph so that its
	53	'stop' action is invoked when dmd is the only process left."
a00dd9fb LC	54	(with-monad %store-monad
	55	(return
	56	(service
	57	(documentation "Take care of the root file system.")
	58	(provision '(root-file-system))
	59	(start #~(const #t))
	60	(stop #~(lambda _
	61	;; Return #f if successfully stopped.
23ed63a1	62	(sync)
a00dd9fb LC	63
	64	(call-with-blocked-asyncs
	65	(lambda ()
	66	(let ((null (%make-void-port "w")))
	67	;; Close 'dmd.log'.
	68	(display "closing log\n")
	69	;; XXX: Ideally we'd use 'stop-logging', but that one
	70	;; doesn't actually close the port as of dmd 0.1.
	71	(close-port (@@ (dmd comm) log-output-port))
	72	(set! (@@ (dmd comm) log-output-port) null)
	73
	74	;; Redirect the default output ports..
	75	(set-current-output-port null)
	76	(set-current-error-port null)
	77
	78	;; Close /dev/console.
	79	(for-each close-fdes '(0 1 2))
	80
23ed63a1	81	;; At this point, there are no open files left, so the
a00dd9fb	82	;; root file system can be re-mounted read-only.
23ed63a1 LC	83	(mount #f "/" #f
	84	(logior MS_REMOUNT MS_RDONLY)
	85	#:update-mtab? #f)
	86
	87	#f)))))
a00dd9fb LC	88	(respawn? #f)))))
	89
	90	(define* (user-processes-service #:key (grace-delay 2))
	91	"Return the service that is responsible for terminating all the processes so
	92	that the root file system can be re-mounted read-only, just before
	93	rebooting/halting. Processes still running GRACE-DELAY seconds after SIGTERM
	94	has been sent are terminated with SIGKILL.
	95
	96	All the services that spawn processes must depend on this one so that they are
	97	stopped before 'kill' is called."
	98	(with-monad %store-monad
	99	(return (service
	100	(documentation "When stopped, terminate all user processes.")
	101	(provision '(user-processes))
	102	(requirement '(root-file-system))
	103	(start #~(const #t))
	104	(stop #~(lambda _
	105	;; When this happens, all the processes have been
	106	;; killed, including 'deco', so DMD-OUTPUT-PORT and
	107	;; thus CURRENT-OUTPUT-PORT are dangling.
	108	(call-with-output-file "/dev/console"
	109	(lambda (port)
	110	(display "sending all processes the TERM signal\n"
	111	port)))
	112
	113	(kill -1 SIGTERM)
	114	(sleep #$grace-delay)
	115	(kill -1 SIGKILL)
	116
	117	(display "all processes have been terminated\n")
	118	#f))
	119	(respawn? #f)))))
	120
db4fdc04 LC	121	(define (host-name-service name)
	122	"Return a service that sets the host name to NAME."
	123	(with-monad %store-monad
	124	(return (service
	125	(documentation "Initialize the machine's host name.")
	126	(provision '(host-name))
b5f4e686 LC	127	(start #~(lambda _
b5f4e686 LC	128	(sethostname #$name)))
db4fdc04 LC	129	(respawn? #f)))))
	130
	131	(define* (mingetty-service tty
	132	#:key
	133	(motd (text-file "motd" "Welcome.\n"))
	134	(allow-empty-passwords? #t))
	135	"Return a service to run mingetty on TTY."
b5f4e686	136	(mlet %store-monad ((motd motd))
db4fdc04 LC	137	(return
	138	(service
	139	(documentation (string-append "Run mingetty on " tty "."))
	140	(provision (list (symbol-append 'term- (string->symbol tty))))
	141
	142	;; Since the login prompt shows the host name, wait for the 'host-name'
	143	;; service to be done.
a00dd9fb	144	(requirement '(user-processes host-name))
db4fdc04	145
b5f4e686 LC	146	(start #~(make-forkexec-constructor
	147	(string-append #$mingetty "/sbin/mingetty")
	148	"--noclear" #$tty))
	149	(stop #~(make-kill-destructor))
db4fdc04 LC	150
	151	(pam-services
	152	;; Let 'login' be known to PAM. All the mingetty services will have
	153	;; that PAM service, but that's fine because they're all identical and
	154	;; duplicates are removed.
	155	(list (unix-pam-service "login"
	156	#:allow-empty-passwords? allow-empty-passwords?
	157	#:motd motd)))))))
	158
	159	(define* (nscd-service #:key (glibc glibc-final))
	160	"Return a service that runs libc's name service cache daemon (nscd)."
b5f4e686	161	(with-monad %store-monad
db4fdc04 LC	162	(return (service
	163	(documentation "Run libc's name service cache daemon (nscd).")
	164	(provision '(nscd))
a00dd9fb	165	(requirement '(user-processes))
b5f4e686 LC	166	(start
	167	#~(make-forkexec-constructor (string-append #$glibc "/sbin/nscd")
	168	"-f" "/dev/null"
	169	"--foreground"))
	170	(stop #~(make-kill-destructor))
db4fdc04	171
b5f4e686	172	(respawn? #f)))))
db4fdc04 LC	173
	174	(define (syslog-service)
	175	"Return a service that runs 'syslogd' with reasonable default settings."
	176
	177	;; Snippet adapted from the GNU inetutils manual.
	178	(define contents "
	179	# Log all kernel messages, authentication messages of
	180	# level notice or higher and anything of level err or
	181	# higher to the console.
	182	# Don't log private authentication messages!
	183	.err;kern.;auth.notice;authpriv.none /dev/console
	184
	185	# Log anything (except mail) of level info or higher.
	186	# Don't log private authentication messages!
	187	*.info;mail.none;authpriv.none /var/log/messages
	188
	189	# Same, in a different place.
	190	*.info;mail.none;authpriv.none /dev/tty12
	191
	192	# The authpriv file has restricted access.
	193	authpriv.* /var/log/secure
	194
	195	# Log all the mail messages in one place.
	196	mail.* /var/log/maillog
	197	")
	198
	199	(mlet %store-monad
b5f4e686	200	((syslog.conf (text-file "syslog.conf" contents)))
db4fdc04 LC	201	(return
	202	(service
	203	(documentation "Run the syslog daemon (syslogd).")
	204	(provision '(syslogd))
a00dd9fb	205	(requirement '(user-processes))
b5f4e686 LC	206	(start
	207	#~(make-forkexec-constructor (string-append #$inetutils
	208	"/libexec/syslogd")
	209	"--no-detach"
	210	"--rcfile" #$syslog.conf))
	211	(stop #~(make-kill-destructor))))))
db4fdc04 LC	212
	213	(define* (guix-build-accounts count #:key
	214	(first-uid 30001)
	215	(gid 30000)
	216	(shadow shadow))
	217	"Return a list of COUNT user accounts for Guix build users, with UIDs
	218	starting at FIRST-UID, and under GID."
	219	(with-monad %store-monad
	220	(return (unfold (cut > <> count)
	221	(lambda (n)
	222	(user-account
	223	(name (format #f "guixbuilder~2,'0d" n))
	224	(password "!")
	225	(uid (+ first-uid n -1))
	226	(gid gid)
	227	(comment (format #f "Guix Build User ~2d" n))
	228	(home-directory "/var/empty")
b5f4e686	229	(shell #~(string-append #$shadow "/sbin/nologin"))))
db4fdc04 LC	230	1+
	231	1))))
	232
	233	(define* (guix-service #:key (guix guix) (builder-group "guixbuild")
	234	(build-user-gid 30000) (build-accounts 10))
	235	"Return a service that runs the build daemon from GUIX, and has
	236	BUILD-ACCOUNTS user accounts available under BUILD-USER-GID."
b5f4e686	237	(mlet %store-monad ((accounts (guix-build-accounts build-accounts
db4fdc04 LC	238	#:gid build-user-gid)))
	239	(return (service
	240	(provision '(guix-daemon))
a00dd9fb	241	(requirement '(user-processes))
b5f4e686 LC	242	(start
	243	#~(make-forkexec-constructor (string-append #$guix
	244	"/bin/guix-daemon")
	245	"--build-users-group"
	246	#$builder-group))
	247	(stop #~(make-kill-destructor))
db4fdc04 LC	248	(user-accounts accounts)
	249	(user-groups (list (user-group
	250	(name builder-group)
	251	(id build-user-gid)
	252	(members (map user-account-name
	253	user-accounts)))))))))
	254
8b198abe LC	255	(define %base-services
	256	;; Convenience variable holding the basic services.
	257	(let ((motd (text-file "motd" "
	258	This is the GNU operating system, welcome!\n\n")))
	259	(list (mingetty-service "tty1" #:motd motd)
	260	(mingetty-service "tty2" #:motd motd)
	261	(mingetty-service "tty3" #:motd motd)
	262	(mingetty-service "tty4" #:motd motd)
	263	(mingetty-service "tty5" #:motd motd)
	264	(mingetty-service "tty6" #:motd motd)
	265	(syslog-service)
	266	(guix-service)
217a5b85	267	(nscd-service))))
8b198abe	268
db4fdc04	269	;;; base.scm ends here