me
/
guix
Archived
1
0
Fork 0

guix system: Add '--graph-backend'.

* guix/scripts/system.scm (lookup-backend): New procedure.
(export-extension-graph, export-shepherd-graph): Add #:backend parameter
and honor it.
(show-help, %options): Add "--graph-backend".
(%default-options): Add 'graph-backend'.
(process-action): Pass #:backend to 'export-extension-graph' and
'export-shepherd-graph'.
* doc/guix.texi (Invoking guix system): Document '--graph-backend'.
master
Ludovic Courtès 2021-01-04 16:43:20 +01:00
parent 475c3278df
commit 6c3690fc57
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 43 additions and 13 deletions

View File

@ -21,7 +21,7 @@
@set SUBSTITUTE-URL https://@value{SUBSTITUTE-SERVER} @set SUBSTITUTE-URL https://@value{SUBSTITUTE-SERVER}
@copying @copying
Copyright @copyright{} 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès@* Copyright @copyright{} 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès@*
Copyright @copyright{} 2013, 2014, 2016 Andreas Enge@* Copyright @copyright{} 2013, 2014, 2016 Andreas Enge@*
Copyright @copyright{} 2013 Nikita Karetnikov@* Copyright @copyright{} 2013 Nikita Karetnikov@*
Copyright @copyright{} 2014, 2015, 2016 Alex Kost@* Copyright @copyright{} 2014, 2015, 2016 Alex Kost@*
@ -31548,10 +31548,12 @@ each other:
@table @code @table @code
@item extension-graph @item extension-graph
Emit in Dot/Graphviz format to standard output the @dfn{service Emit to standard output the @dfn{service
extension graph} of the operating system defined in @var{file} extension graph} of the operating system defined in @var{file}
(@pxref{Service Composition}, for more information on service (@pxref{Service Composition}, for more information on service
extensions). extensions). By default the output is in Dot/Graphviz format, but you
can choose a different format with @option{--graph-backend}, as with
@command{guix graph} (@pxref{Invoking guix graph, @option{--backend}}):
The command: The command:
@ -31563,11 +31565,14 @@ shows the extension relations among services.
@anchor{system-shepherd-graph} @anchor{system-shepherd-graph}
@item shepherd-graph @item shepherd-graph
Emit in Dot/Graphviz format to standard output the @dfn{dependency Emit to standard output the @dfn{dependency
graph} of shepherd services of the operating system defined in graph} of shepherd services of the operating system defined in
@var{file}. @xref{Shepherd Services}, for more information and for an @var{file}. @xref{Shepherd Services}, for more information and for an
example graph. example graph.
Again, the default output format is Dot/Graphviz, but you can pass
@option{--graph-backend} to select a different one.
@end table @end table
@node Invoking guix deploy @node Invoking guix deploy

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Alex Kost <alezost@gmail.com> ;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
;;; Copyright © 2016, 2017, 2018 Chris Marusich <cmmarusich@gmail.com> ;;; Copyright © 2016, 2017, 2018 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2017, 2019 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2017, 2019 Mathieu Othacehe <m.othacehe@gmail.com>
@ -48,7 +48,8 @@
#:autoload (guix scripts package) (delete-generations #:autoload (guix scripts package) (delete-generations
delete-matching-generations) delete-matching-generations)
#:autoload (guix scripts pull) (channel-commit-hyperlink) #:autoload (guix scripts pull) (channel-commit-hyperlink)
#:use-module (guix graph) #:autoload (guix graph) (export-graph node-type
graph-backend-name %graph-backends)
#:use-module (guix scripts graph) #:use-module (guix scripts graph)
#:use-module (guix scripts system reconfigure) #:use-module (guix scripts system reconfigure)
#:use-module (guix build utils) #:use-module (guix build utils)
@ -887,18 +888,28 @@ Run 'herd status' to view the list of services on your system.\n"))))))
(register-root* (list output) gc-root)) (register-root* (list output) gc-root))
(return output))))))))) (return output)))))))))
(define (export-extension-graph os port) (define (lookup-backend name) ;TODO: factorize
"Export the service extension graph of OS to PORT." "Return the graph backend called NAME. Raise an error if it is not found."
(or (find (lambda (backend)
(string=? (graph-backend-name backend) name))
%graph-backends)
(leave (G_ "~a: unknown backend~%") name)))
(define* (export-extension-graph os port
#:key (backend (lookup-backend "graphviz")))
"Export the service extension graph of OS to PORT using BACKEND."
(let* ((services (operating-system-services os)) (let* ((services (operating-system-services os))
(system (find (lambda (service) (system (find (lambda (service)
(eq? (service-kind service) system-service-type)) (eq? (service-kind service) system-service-type))
services))) services)))
(export-graph (list system) (current-output-port) (export-graph (list system) (current-output-port)
#:backend backend
#:node-type (service-node-type services) #:node-type (service-node-type services)
#:reverse-edges? #t))) #:reverse-edges? #t)))
(define (export-shepherd-graph os port) (define* (export-shepherd-graph os port
"Export the graph of shepherd services of OS to PORT." #:key (backend (lookup-backend "graphviz")))
"Export the graph of shepherd services of OS to PORT using BACKEND."
(let* ((services (operating-system-services os)) (let* ((services (operating-system-services os))
(pid1 (fold-services services (pid1 (fold-services services
#:target-type shepherd-root-service-type)) #:target-type shepherd-root-service-type))
@ -907,6 +918,7 @@ Run 'herd status' to view the list of services on your system.\n"))))))
(null? (shepherd-service-requirement service))) (null? (shepherd-service-requirement service)))
shepherds))) shepherds)))
(export-graph sinks (current-output-port) (export-graph sinks (current-output-port)
#:backend backend
#:node-type (shepherd-service-node-type shepherds) #:node-type (shepherd-service-node-type shepherds)
#:reverse-edges? #t))) #:reverse-edges? #t)))
@ -1014,6 +1026,10 @@ Some ACTIONS support additional ARGS.\n"))
(display (G_ " (display (G_ "
-v, --verbosity=LEVEL use the given verbosity LEVEL")) -v, --verbosity=LEVEL use the given verbosity LEVEL"))
(newline) (newline)
(display (G_ "
--graph-backend=BACKEND
use BACKEND for 'extension-graphs' and 'shepherd-graph'"))
(newline)
(display (G_ " (display (G_ "
-h, --help display this help and exit")) -h, --help display this help and exit"))
(display (G_ " (display (G_ "
@ -1109,6 +1125,9 @@ Some ACTIONS support additional ARGS.\n"))
(option '(#\r "root") #t #f (option '(#\r "root") #t #f
(lambda (opt name arg result) (lambda (opt name arg result)
(alist-cons 'gc-root arg result))) (alist-cons 'gc-root arg result)))
(option '("graph-backend") #t #f
(lambda (opt name arg result)
(alist-cons 'graph-backend arg result)))
%standard-build-options)) %standard-build-options))
(define %default-options (define %default-options
@ -1128,7 +1147,8 @@ Some ACTIONS support additional ARGS.\n"))
(image-size . guess) (image-size . guess)
(install-bootloader? . #t) (install-bootloader? . #t)
(label . #f) (label . #f)
(volatile-root? . #f))) (volatile-root? . #f)
(graph-backend . "graphviz")))
(define (verbosity-level opts) (define (verbosity-level opts)
"Return the verbosity level based on OPTS, the alist of parsed options." "Return the verbosity level based on OPTS, the alist of parsed options."
@ -1191,6 +1211,9 @@ resulting from command-line parsing."
(bootloader-configuration-target (bootloader-configuration-target
(operating-system-bootloader os))))) (operating-system-bootloader os)))))
(define (graph-backend)
(lookup-backend (assoc-ref opts 'graph-backend)))
(with-store store (with-store store
(set-build-options-from-command-line store opts) (set-build-options-from-command-line store opts)
@ -1205,9 +1228,11 @@ resulting from command-line parsing."
(set-guile-for-build (default-guile)) (set-guile-for-build (default-guile))
(case action (case action
((extension-graph) ((extension-graph)
(export-extension-graph os (current-output-port))) (export-extension-graph os (current-output-port)
#:backend (graph-backend)))
((shepherd-graph) ((shepherd-graph)
(export-shepherd-graph os (current-output-port))) (export-shepherd-graph os (current-output-port)
#:backend (graph-backend)))
(else (else
(unless (memq action '(build init)) (unless (memq action '(build init))
(warn-about-old-distro #:suggested-command (warn-about-old-distro #:suggested-command