mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
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
parent
80a6773483
commit
6f305ea5fd
5 changed files with 133 additions and 7 deletions
1
.gitignore
vendored
1
.gitignore
vendored
|
|
@ -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
3
doc.am
|
|
@ -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) \
|
||||
|
|
|
|||
|
|
@ -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
75
doc/images/dmd-graph.dot
Normal 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];
|
||||
|
||||
}
|
||||
|
|
@ -36,6 +36,7 @@ (define-module (guix scripts system)
|
|||
#: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 @@ (define (system->grub-entry system number time)
|
|||
|
||||
|
||||
;;;
|
||||
;;; Graph.
|
||||
;;; Graphs.
|
||||
;;;
|
||||
|
||||
(define (service-node-label service)
|
||||
|
|
@ -311,6 +312,18 @@ (define (service-node-type 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 @@ (define (export-extension-graph os port)
|
|||
#: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 @@ (define (show-help)
|
|||
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 @@ (define (parse-sub-command arg result)
|
|||
(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 @@ (define (fail)
|
|||
(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?
|
||||
|
|
|
|||
Loading…
Reference in a new issue