gnu: dmd: Add service documentation.

* gnu/system/dmd.scm (<service>): Add 'documentation' field.
  (host-name-service, mingetty-service, nscd-service, syslog-service,
  static-networking-service): Provide a 'documentation' value.
  (dmd-configuration-file): Use it.
This commit is contained in:
Ludovic Courtès 2013-11-27 22:39:07 +01:00
parent b455a11868
commit b4f0bb1771

View file

@ -59,6 +59,8 @@ (define-module (gnu system dmd)
(define-record-type* <service> (define-record-type* <service>
service make-service service make-service
service? service?
(documentation service-documentation ; string
(default "[No documentation.]"))
(provision service-provision) ; list of symbols (provision service-provision) ; list of symbols
(requirement service-requirement ; list of symbols (requirement service-requirement ; list of symbols
(default '())) (default '()))
@ -74,6 +76,7 @@ (define (host-name-service name)
"Return a service that sets the host name to NAME." "Return a service that sets the host name to NAME."
(with-monad %store-monad (with-monad %store-monad
(return (service (return (service
(documentation "Initialize the machine's host name.")
(provision '(host-name)) (provision '(host-name))
(start `(lambda _ (start `(lambda _
(sethostname ,name))) (sethostname ,name)))
@ -84,6 +87,7 @@ (define (mingetty-service tty)
(mlet %store-monad ((mingetty-bin (package-file mingetty "sbin/mingetty"))) (mlet %store-monad ((mingetty-bin (package-file mingetty "sbin/mingetty")))
(return (return
(service (service
(documentation (string-append "Run mingetty on " tty "."))
(provision (list (symbol-append 'term- (string->symbol tty)))) (provision (list (symbol-append 'term- (string->symbol tty))))
;; Since the login prompt shows the host name, wait for the 'host-name' ;; Since the login prompt shows the host name, wait for the 'host-name'
@ -97,6 +101,7 @@ (define* (nscd-service #:key (glibc glibc-final))
"Return a service that runs libc's name service cache daemon (nscd)." "Return a service that runs libc's name service cache daemon (nscd)."
(mlet %store-monad ((nscd (package-file glibc "sbin/nscd"))) (mlet %store-monad ((nscd (package-file glibc "sbin/nscd")))
(return (service (return (service
(documentation "Run libc's name service cache daemon (nscd).")
(provision '(nscd)) (provision '(nscd))
(start `(make-forkexec-constructor ,nscd "-f" "/dev/null")) (start `(make-forkexec-constructor ,nscd "-f" "/dev/null"))
@ -140,6 +145,7 @@ (define contents "
(syslogd (package-file inetutils "libexec/syslogd"))) (syslogd (package-file inetutils "libexec/syslogd")))
(return (return
(service (service
(documentation "Run the syslog daemon (syslogd).")
(provision '(syslogd)) (provision '(syslogd))
(start `(make-forkexec-constructor ,syslogd (start `(make-forkexec-constructor ,syslogd
"--rcfile" ,syslog.conf)) "--rcfile" ,syslog.conf))
@ -171,6 +177,9 @@ (define* (static-networking-service interface ip
(route (package-file net-tools "sbin/route"))) (route (package-file net-tools "sbin/route")))
(return (return
(service (service
(documentation
(string-append "Set up networking on the '" interface
"' interface using a static IP address."))
(provision '(networking)) (provision '(networking))
(start `(lambda _ (start `(lambda _
(and (zero? (system* ,ifconfig ,interface ,ip "up")) (and (zero? (system* ,ifconfig ,interface ,ip "up"))
@ -196,8 +205,10 @@ (define config
`(begin `(begin
(register-services (register-services
,@(map (match-lambda ,@(map (match-lambda
(($ <service> provision requirement respawn? start stop) (($ <service> documentation provision requirement
respawn? start stop)
`(make <service> `(make <service>
#:docstring ,documentation
#:provides ',provision #:provides ',provision
#:requires ',requirement #:requires ',requirement
#:respawn? ,respawn? #:respawn? ,respawn?