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:
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
|
must exist and be readable and writable by the user and by the daemon's
|
||||||
build users.
|
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
|
@node Defining Services
|
||||||
@subsection 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}
|
daemon; the @file{/etc} service populates the system's @file{/etc}
|
||||||
directory.
|
directory.
|
||||||
|
|
||||||
|
@cindex service extensions
|
||||||
GuixSD services are connected by @dfn{extensions}. For instance, the
|
GuixSD services are connected by @dfn{extensions}. For instance, the
|
||||||
secure shell service @emph{extends} dmd---GuixSD's initialization system,
|
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
|
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
|
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.
|
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
|
@cindex service types
|
||||||
Technically, developers can define @dfn{service types} to express these
|
Technically, developers can define @dfn{service types} to express these
|
||||||
|
|
|
@ -28,12 +28,14 @@
|
||||||
#:use-module (guix profiles)
|
#:use-module (guix profiles)
|
||||||
#:use-module (guix scripts)
|
#:use-module (guix scripts)
|
||||||
#:use-module (guix scripts build)
|
#:use-module (guix scripts build)
|
||||||
|
#:use-module (guix scripts graph)
|
||||||
#:use-module (guix build utils)
|
#:use-module (guix build utils)
|
||||||
#:use-module (gnu build install)
|
#:use-module (gnu build install)
|
||||||
#:use-module (gnu system)
|
#:use-module (gnu system)
|
||||||
#:use-module (gnu system file-systems)
|
#:use-module (gnu system file-systems)
|
||||||
#:use-module (gnu system vm)
|
#:use-module (gnu system vm)
|
||||||
#:use-module (gnu system grub)
|
#:use-module (gnu system grub)
|
||||||
|
#:use-module (gnu services)
|
||||||
#:use-module (gnu packages grub)
|
#:use-module (gnu packages grub)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-19)
|
#:use-module (srfi srfi-19)
|
||||||
|
@ -278,6 +280,38 @@ it atomically, and then run OS's activation script."
|
||||||
systems)))
|
systems)))
|
||||||
(filter-map system->grub-entry systems numbers times)))
|
(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.
|
;;; Action.
|
||||||
|
@ -366,6 +400,16 @@ building anything."
|
||||||
;; All we had to do was to build SYS.
|
;; All we had to do was to build SYS.
|
||||||
(return (derivation->output-path 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.
|
;;; Options.
|
||||||
|
@ -388,7 +432,9 @@ Build the operating system declared in FILE according to ACTION.\n"))
|
||||||
(display (_ "\
|
(display (_ "\
|
||||||
disk-image build a disk image, suitable for a USB stick\n"))
|
disk-image build a disk image, suitable for a USB stick\n"))
|
||||||
(display (_ "\
|
(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)
|
(show-build-options-help)
|
||||||
(display (_ "
|
(display (_ "
|
||||||
|
@ -496,7 +542,8 @@ Build the operating system declared in FILE according to ACTION.\n"))
|
||||||
(alist-cons 'argument arg result)
|
(alist-cons 'argument arg result)
|
||||||
(let ((action (string->symbol arg)))
|
(let ((action (string->symbol arg)))
|
||||||
(case action
|
(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))
|
(alist-cons 'action action result))
|
||||||
(else (leave (_ "~a: unknown action~%") action))))))
|
(else (leave (_ "~a: unknown action~%") action))))))
|
||||||
|
|
||||||
|
@ -561,6 +608,10 @@ Build the operating system declared in FILE according to ACTION.\n"))
|
||||||
(run-with-store store
|
(run-with-store store
|
||||||
(mbegin %store-monad
|
(mbegin %store-monad
|
||||||
(set-guile-for-build (default-guile))
|
(set-guile-for-build (default-guile))
|
||||||
|
(case action
|
||||||
|
((extension-graph)
|
||||||
|
(export-extension-graph os (current-output-port)))
|
||||||
|
(else
|
||||||
(perform-action action os
|
(perform-action action os
|
||||||
#:dry-run? dry?
|
#:dry-run? dry?
|
||||||
#:derivations-only? (assoc-ref opts
|
#:derivations-only? (assoc-ref opts
|
||||||
|
@ -574,7 +625,7 @@ Build the operating system declared in FILE according to ACTION.\n"))
|
||||||
(_ #f))
|
(_ #f))
|
||||||
opts)
|
opts)
|
||||||
#:grub? grub?
|
#:grub? grub?
|
||||||
#:target target #:device device))
|
#:target target #:device device))))
|
||||||
#:system system))))
|
#:system system))))
|
||||||
|
|
||||||
;;; system.scm ends here
|
;;; system.scm ends here
|
||||||
|
|
Loading…
Reference in New Issue