guix system: Add 'dmd-graph' command.

* guix/scripts/system.scm (dmd-service-node-label,
  dmd-service-node-type, export-dmd-graph): New procedures.
  (show-help): Add 'dmd-graph'.
  (guix-system)[parse-sub-command]: Likewise.
  Honor it.
* doc/guix.texi (Invoking guix system): Document it.
  (dmd Services): Add an illustration and explanation.
* doc/images/dmd-graph.dot: New file.
* doc.am (DOT_FILES): Add it.
This commit is contained in:
Ludovic Courtès 2015-10-14 19:17:12 +02:00
parent 80a6773483
commit 6f305ea5fd
5 changed files with 133 additions and 7 deletions

1
.gitignore vendored
View File

@ -132,3 +132,4 @@ GTAGS
/doc/images/service-graph.png
/doc/images/service-graph.eps
/doc/images/service-graph.pdf
/doc/images/dmd-graph.png

3
doc.am
View File

@ -23,7 +23,8 @@ DOT_FILES = \
doc/images/bootstrap-graph.dot \
doc/images/coreutils-graph.dot \
doc/images/coreutils-bag-graph.dot \
doc/images/service-graph.dot
doc/images/service-graph.dot \
doc/images/dmd-graph.dot
DOT_VECTOR_GRAPHICS = \
$(DOT_FILES:%.dot=%.eps) \

View File

@ -7004,6 +7004,12 @@ $ guix system extension-graph @var{file} | dot -Tpdf > services.pdf
produces a PDF file showing the extension relations among services.
@anchor{system-dmd-graph}
@item dmd-graph
Emit in Dot/Graphviz format to standard output the @dfn{dependency
graph} of dmd services of the operating system defined in @var{file}.
@xref{dmd Services}, for more information and for an example graph.
@end table
@ -7332,10 +7338,23 @@ setuid-root programs on the system (@pxref{Setuid Programs}).
The @code{(gnu services dmd)} provides a way to define services managed
by GNU@tie{}dmd, which is GuixSD initialization system---the first
process that is started when the system boots, aka. PID@tie{}1
(@pxref{Introduction,,, dmd, GNU dmd Manual}). The
@var{%dmd-root-service} represents PID@tie{}1, of type
@var{dmd-root-service-type}; it can be extended by passing it lists of
@code{<dmd-service>} objects.
(@pxref{Introduction,,, dmd, GNU dmd Manual}).
Services in dmd can depend on each other. For instance, the SSH daemon
may need to be started after the syslog daemon has been started, which
in turn can only happen once all the file systems have been mounted.
The simple operating system defined earlier (@pxref{Using the
Configuration System}) results in a service graph like this:
@image{images/dmd-graph,,5in,Typical dmd service graph.}
You can actually generate such a graph for any operating system
definition using the @command{guix system dmd-graph} command
(@pxref{system-dmd-graph, @command{guix system dmd-graph}}).
The @var{%dmd-root-service} is a service object representing PID@tie{}1,
of type @var{dmd-root-service-type}; it can be extended by passing it
lists of @code{<dmd-service>} objects.
@deftp {Data Type} dmd-service
The data type representing a service managed by dmd.

75
doc/images/dmd-graph.dot Normal file
View File

@ -0,0 +1,75 @@
digraph "Guix dmd-service" {
"user-file-systems" [label = "user-file-systems", shape = box, fontname = Helvetica];
"user-processes" -> "user-file-systems" [color = red];
"user-processes" [label = "user-processes", shape = box, fontname = Helvetica];
"nscd" -> "user-processes" [color = red];
"guix-daemon" -> "user-processes" [color = red];
"syslogd" -> "user-processes" [color = red];
"term-tty6" -> "user-processes" [color = red];
"term-tty5" -> "user-processes" [color = red];
"term-tty4" -> "user-processes" [color = red];
"term-tty3" -> "user-processes" [color = red];
"term-tty2" -> "user-processes" [color = red];
"term-tty1" -> "user-processes" [color = red];
"networking" -> "user-processes" [color = red];
"nscd" [label = "nscd", shape = box, fontname = Helvetica];
"guix-daemon" [label = "guix-daemon", shape = box, fontname = Helvetica];
"syslogd" [label = "syslogd", shape = box, fontname = Helvetica];
"ssh-daemon" -> "syslogd" [color = red];
"ssh-daemon" [label = "ssh-daemon", shape = box, fontname = Helvetica];
"term-tty6" [label = "term-tty6", shape = box, fontname = Helvetica];
"console-font-tty6" -> "term-tty6" [color = red];
"console-font-tty6" [label = "console-font-tty6", shape = box, fontname = Helvetica];
"term-tty5" [label = "term-tty5", shape = box, fontname = Helvetica];
"console-font-tty5" -> "term-tty5" [color = red];
"console-font-tty5" [label = "console-font-tty5", shape = box, fontname = Helvetica];
"term-tty4" [label = "term-tty4", shape = box, fontname = Helvetica];
"console-font-tty4" -> "term-tty4" [color = red];
"console-font-tty4" [label = "console-font-tty4", shape = box, fontname = Helvetica];
"term-tty3" [label = "term-tty3", shape = box, fontname = Helvetica];
"console-font-tty3" -> "term-tty3" [color = red];
"console-font-tty3" [label = "console-font-tty3", shape = box, fontname = Helvetica];
"term-tty2" [label = "term-tty2", shape = box, fontname = Helvetica];
"console-font-tty2" -> "term-tty2" [color = red];
"console-font-tty2" [label = "console-font-tty2", shape = box, fontname = Helvetica];
"term-tty1" [label = "term-tty1", shape = box, fontname = Helvetica];
"console-font-tty1" -> "term-tty1" [color = red];
"console-font-tty1" [label = "console-font-tty1", shape = box, fontname = Helvetica];
"networking" [label = "networking", shape = box, fontname = Helvetica];
"ssh-daemon" -> "networking" [color = red];
"root-file-system" [label = "root-file-system", shape = box, fontname = Helvetica];
"file-system-/run/user" -> "root-file-system" [color = red];
"file-system-/run/systemd" -> "root-file-system" [color = red];
"file-system-/gnu/store" -> "root-file-system" [color = red];
"file-system-/dev/shm" -> "root-file-system" [color = red];
"file-system-/dev/pts" -> "root-file-system" [color = red];
"user-processes" -> "root-file-system" [color = red];
"udev" -> "root-file-system" [color = red];
"file-system-/run/user" [label = "file-system-/run/user", shape = box, fontname = Helvetica];
"user-processes" -> "file-system-/run/user" [color = red];
"file-system-/run/systemd" [label = "file-system-/run/systemd", shape = box, fontname = Helvetica];
"user-processes" -> "file-system-/run/systemd" [color = red];
"file-system-/gnu/store" [label = "file-system-/gnu/store", shape = box, fontname = Helvetica];
"user-processes" -> "file-system-/gnu/store" [color = red];
"file-system-/dev/shm" [label = "file-system-/dev/shm", shape = box, fontname = Helvetica];
"user-processes" -> "file-system-/dev/shm" [color = red];
"file-system-/dev/pts" [label = "file-system-/dev/pts", shape = box, fontname = Helvetica];
"user-processes" -> "file-system-/dev/pts" [color = red];
"udev" [label = "udev", shape = box, fontname = Helvetica];
"term-tty6" -> "udev" [color = red];
"term-tty5" -> "udev" [color = red];
"term-tty4" -> "udev" [color = red];
"term-tty3" -> "udev" [color = red];
"term-tty2" -> "udev" [color = red];
"term-tty1" -> "udev" [color = red];
"networking" -> "udev" [color = red];
"host-name" [label = "host-name", shape = box, fontname = Helvetica];
"term-tty6" -> "host-name" [color = red];
"term-tty5" -> "host-name" [color = red];
"term-tty4" -> "host-name" [color = red];
"term-tty3" -> "host-name" [color = red];
"term-tty2" -> "host-name" [color = red];
"term-tty1" -> "host-name" [color = red];
"loopback" [label = "loopback", shape = box, fontname = Helvetica];
}

View File

@ -36,6 +36,7 @@
#:use-module (gnu system vm)
#:use-module (gnu system grub)
#:use-module (gnu services)
#:use-module (gnu services dmd)
#:use-module (gnu packages grub)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-19)
@ -282,7 +283,7 @@ it atomically, and then run OS's activation script."
;;;
;;; Graph.
;;; Graphs.
;;;
(define (service-node-label service)
@ -311,6 +312,18 @@ list of services."
(label service-node-label)
(edges (lift1 (service-back-edges services) %store-monad))))
(define (dmd-service-node-label service)
"Return a label for a node representing a <dmd-service>."
(string-join (map symbol->string (dmd-service-provision service))))
(define (dmd-service-node-type services)
"Return a node type for SERVICES, a list of <dmd-service>."
(node-type
(name "dmd-service")
(description "the dependency graph of dmd services")
(identifier (lift1 dmd-service-node-label %store-monad))
(label dmd-service-node-label)
(edges (lift1 (dmd-service-back-edges services) %store-monad))))
;;;
@ -410,6 +423,19 @@ building anything."
#:node-type (service-node-type services)
#:reverse-edges? #t)))
(define (export-dmd-graph os port)
"Export the graph of dmd services of OS to PORT."
(let* ((services (operating-system-services os))
(pid1 (fold-services services
#:target-type dmd-root-service-type))
(dmds (service-parameters pid1)) ;the list of <dmd-service>
(sinks (filter (lambda (service)
(null? (dmd-service-requirement service)))
dmds)))
(export-graph sinks (current-output-port)
#:node-type (dmd-service-node-type dmds)
#:reverse-edges? #t)))
;;;
;;; Options.
@ -435,6 +461,8 @@ Build the operating system declared in FILE according to ACTION.\n"))
init initialize a root file system to run GNU\n"))
(display (_ "\
extension-graph emit the service extension graph in Dot format\n"))
(display (_ "\
dmd-graph emit the graph of dmd services in Dot format\n"))
(show-build-options-help)
(display (_ "
@ -543,7 +571,7 @@ Build the operating system declared in FILE according to ACTION.\n"))
(let ((action (string->symbol arg)))
(case action
((build vm vm-image disk-image reconfigure init
extension-graph)
extension-graph dmd-graph)
(alist-cons 'action action result))
(else (leave (_ "~a: unknown action~%") action))))))
@ -611,6 +639,8 @@ Build the operating system declared in FILE according to ACTION.\n"))
(case action
((extension-graph)
(export-extension-graph os (current-output-port)))
((dmd-graph)
(export-dmd-graph os (current-output-port)))
(else
(perform-action action os
#:dry-run? dry?