diff options
| -rw-r--r-- | doc/guix.texi | 28 | ||||
| -rw-r--r-- | guix/scripts/system.scm | 89 |
2 files changed, 98 insertions, 19 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index 9956887b96..0e0e507714 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -6983,6 +6983,30 @@ KVM kernel module should be loaded, and the @file{/dev/kvm} device node must exist and be readable and writable by the user and by the daemon's build users. +The @command{guix system} command has even more to offer! The following +sub-commands allow you to visualize how your system services relate to +each other: + +@anchor{system-extension-graph} +@table @code + +@item extension-graph +Emit in Dot/Graphviz format to standard output the @dfn{service +extension graph} of the operating system defined in @var{file} +(@pxref{Service Composition}, for more information on service +extensions.) + +The command: + +@example +$ guix system extension-graph @var{file} | dot -Tpdf > services.pdf +@end example + +produces a PDF file showing the extension relations among services. + +@end table + + @node Defining Services @subsection Defining Services @@ -7015,6 +7039,7 @@ collects device management rules and makes them available to the eudev daemon; the @file{/etc} service populates the system's @file{/etc} directory. +@cindex service extensions GuixSD services are connected by @dfn{extensions}. For instance, the secure shell service @emph{extends} dmd---GuixSD's initialization system, running as PID@tie{}1---by giving it the command lines to start and stop @@ -7035,6 +7060,9 @@ as arrows, a typical system might provide something like this: At the bottom, we see the @dfn{boot service}, which produces the boot script that is executed at boot time from the initial RAM disk. +@xref{system-extension-graph, the @command{guix system extension-graph} +command}, for information on how to generate this representation for a +particular operating system definition. @cindex service types Technically, developers can define @dfn{service types} to express these diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 71b92dacc7..9160969b95 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -28,12 +28,14 @@ #:use-module (guix profiles) #:use-module (guix scripts) #:use-module (guix scripts build) + #:use-module (guix scripts graph) #:use-module (guix build utils) #:use-module (gnu build install) #:use-module (gnu system) #:use-module (gnu system file-systems) #:use-module (gnu system vm) #:use-module (gnu system grub) + #:use-module (gnu services) #:use-module (gnu packages grub) #:use-module (srfi srfi-1) #:use-module (srfi srfi-19) @@ -280,6 +282,38 @@ it atomically, and then run OS's activation script." ;;; +;;; Graph. +;;; + +(define (service-node-label service) + "Return a label to represent SERVICE." + (let ((type (service-kind service)) + (value (service-parameters service))) + (string-append (symbol->string (service-type-name type)) + (cond ((or (number? value) (symbol? value)) + (string-append " " (object->string value))) + ((string? value) + (string-append " " value)) + ((file-system? value) + (string-append " " (file-system-mount-point value))) + (else + ""))))) + +(define (service-node-type services) + "Return a node type for SERVICES. Since <service> instances are not +self-contained (they express dependencies on service types, not on services), +we have to create the 'edges' procedure dynamically as a function of the full +list of services." + (node-type + (name "service") + (description "the DAG of services") + (identifier (lift1 object-address %store-monad)) + (label service-node-label) + (edges (lift1 (service-back-edges services) %store-monad)))) + + + +;;; ;;; Action. ;;; @@ -366,6 +400,16 @@ building anything." ;; All we had to do was to build SYS. (return (derivation->output-path sys)))))))) +(define (export-extension-graph os port) + "Export the service extension graph of OS to PORT." + (let* ((services (operating-system-services os)) + (boot (find (lambda (service) + (eq? (service-kind service) boot-service-type)) + services))) + (export-graph (list boot) (current-output-port) + #:node-type (service-node-type services) + #:reverse-edges? #t))) + ;;; ;;; Options. @@ -388,7 +432,9 @@ Build the operating system declared in FILE according to ACTION.\n")) (display (_ "\ disk-image build a disk image, suitable for a USB stick\n")) (display (_ "\ - init initialize a root file system to run GNU.\n")) + init initialize a root file system to run GNU\n")) + (display (_ "\ + extension-graph emit the service extension graph in Dot format\n")) (show-build-options-help) (display (_ " @@ -496,16 +542,17 @@ Build the operating system declared in FILE according to ACTION.\n")) (alist-cons 'argument arg result) (let ((action (string->symbol arg))) (case action - ((build vm vm-image disk-image reconfigure init) + ((build vm vm-image disk-image reconfigure init + extension-graph) (alist-cons 'action action result)) (else (leave (_ "~a: unknown action~%") action)))))) (define (match-pair car) ;; Return a procedure that matches a pair with CAR. (match-lambda - ((head . tail) - (and (eq? car head) tail)) - (_ #f))) + ((head . tail) + (and (eq? car head) tail)) + (_ #f))) (define (option-arguments opts) ;; Extract the plain arguments from OPTS. @@ -561,20 +608,24 @@ Build the operating system declared in FILE according to ACTION.\n")) (run-with-store store (mbegin %store-monad (set-guile-for-build (default-guile)) - (perform-action action os - #:dry-run? dry? - #:derivations-only? (assoc-ref opts - 'derivations-only?) - #:use-substitutes? (assoc-ref opts 'substitutes?) - #:image-size (assoc-ref opts 'image-size) - #:full-boot? (assoc-ref opts 'full-boot?) - #:mappings (filter-map (match-lambda - (('file-system-mapping . m) - m) - (_ #f)) - opts) - #:grub? grub? - #:target target #:device device)) + (case action + ((extension-graph) + (export-extension-graph os (current-output-port))) + (else + (perform-action action os + #:dry-run? dry? + #:derivations-only? (assoc-ref opts + 'derivations-only?) + #:use-substitutes? (assoc-ref opts 'substitutes?) + #:image-size (assoc-ref opts 'image-size) + #:full-boot? (assoc-ref opts 'full-boot?) + #:mappings (filter-map (match-lambda + (('file-system-mapping . m) + m) + (_ #f)) + opts) + #:grub? grub? + #:target target #:device device)))) #:system system)))) ;;; system.scm ends here |