guix system: Add 'extension-graph' command.
* guix/scripts/system.scm (service-node-label, service-node-type, export-extension-graph): New procedures. (guix-system)[parse-sub-command]: Add 'extension-graph'. Honor it. (show-help): Add 'extension-graph'. * doc/guix.texi (Invoking guix system): Document it. (Service Composition): Add cross-reference.
This commit is contained in:
Ludovic Courtès
parent
a64cd7b65f
commit
d6c3267a32
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
@ -278,6 +280,38 @@ it atomically, and then run OS's activation script."
|
|||
systems)))
|
||||
(filter-map system->grub-entry systems numbers times)))
|
||||
|
||||
|
||||
;;;
|
||||
;;; 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
|
||||
|
|
|
|||
Loading…
Reference in New Issue