From 48945997d9139ddc5e288512de3dda8d5accaf44 Mon Sep 17 00:00:00 2001
From: John Soo <jsoo1@asu.edu>
Date: Wed, 4 Nov 2020 07:51:52 -0800
Subject: [PATCH] processes: Optionally normalize recutils output.
* guix/scripts/processes.scm: Add "normalize" flag
---
doc/guix.texi | 27 ++++++++++
guix/scripts/processes.scm | 105 ++++++++++++++++++++++++++++++++-----
2 files changed, 120 insertions(+), 12 deletions(-)
@@ -82,6 +82,7 @@ Copyright @copyright{} 2020 Pierre Langlois@*
Copyright @copyright{} 2020 pinoaffe@*
Copyright @copyright{} 2020 André Batista@*
Copyright @copyright{} 2020 Alexandru-Sergiu Marton@*
+Copyright @copyright{} 2020 John Soo@*
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -12691,6 +12692,32 @@ ClientPID: 19419
ClientCommand: cuirass --cache-directory /var/cache/cuirass @dots{}
@end example
+Additional options are listed below.
+
+@table @code
+@item --normalize
+Normalize the output records into record sets (@pxref{Record Sets,,,
+recutils, GNU recutils manual}). Normalizing into record sets allows
+joins across record types.
+
+@example
+$ guix processes --normalize | \
+ recsel \
+ -j Session \
+ -t ChildProcess \
+ -p Session.PID,PID \
+ -e 'Session.ClientCommand ~ build'
+Session_PID: 4278
+PID: 4435
+
+Session_PID: 4278
+PID: 4554
+
+Session_PID: 4278
+PID: 4646
+@end example
+@end table
+
@node System Configuration
@chapter System Configuration
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020 John Soo <jsoo1@asu.edu>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -176,6 +177,9 @@ active sessions, and the master 'guix-daemon' process."
(values (filter-map child-process->session children)
master)))
+(define (lock->record lock port)
+ (format port "LockHeld: ~a~%" lock))
+
(define (daemon-session->recutils session port)
"Display SESSION information in recutils format on PORT."
(format port "SessionPID: ~a~%"
@@ -184,8 +188,7 @@ active sessions, and the master 'guix-daemon' process."
(process-id (daemon-session-client session)))
(format port "ClientCommand:~{ ~a~}~%"
(process-command (daemon-session-client session)))
- (for-each (lambda (lock)
- (format port "LockHeld: ~a~%" lock))
+ (for-each (lambda (lock) (lock->record lock port))
(daemon-session-locks-held session))
(for-each (lambda (process)
(format port "ChildProcess: ~a:~{ ~a~}~%"
@@ -193,6 +196,81 @@ active sessions, and the master 'guix-daemon' process."
(process-command process)))
(daemon-session-children session)))
+(define (format-single-record port)
+ "Display denormalized session information to PORT."
+ (for-each (lambda (session)
+ (daemon-session->recutils session port)
+ (newline port))
+ (daemon-sessions)))
+
+(define session-rec-type
+ ;; Also includes ClientCommand and LockHeld but it doesn't seem to be
+ ;; possible to express a plain string field (the default) without further
+ ;; restrictions
+ "%rec: Session
+%type: PID int
+%type: ClientPID int
+%key: PID")
+
+(define child-process-rec-type
+ ;; Also includes Command but it doesn't seem to be possible to
+ ;; express a plain string field (the default) without further restrictions
+ "%rec: ChildProcess
+%type: Session rec Session
+%type: PID int
+%key: PID")
+
+(define (session-key->field session port)
+ "Display SESSION PID as field on PORT."
+ (format
+ port "Session: ~a"
+ (process-id (daemon-session-process session))))
+
+(define (session-scalars->normalized-record session port)
+ "Display SESSION scalar fields to PORT in normalized form."
+ (format port "PID: ~a~%"
+ (process-id (daemon-session-process session)))
+ (format port "ClientPID: ~a~%"
+ (process-id (daemon-session-client session)))
+ (format port "ClientCommand:~{ ~a~}~%"
+ (process-command (daemon-session-client session))))
+
+(define (child-process->normalized-record process port)
+ "Display PROCESS record on PORT in normalized form"
+ (format port "PID: ~a" (process-id process))
+ (newline port)
+ (format port "Command:~{ ~a~}" (process-command process)))
+
+(define (format-normalized port)
+ (define sessions (daemon-sessions))
+
+ (format port session-rec-type)
+ (newline port)
+ (newline port)
+ (for-each
+ (lambda (session)
+ (session-scalars->normalized-record session port)
+ (for-each
+ (lambda (lock) (lock->record lock port))
+ (daemon-session-locks-held session))
+ (newline port))
+ sessions)
+
+ (format port child-process-rec-type)
+ (newline port)
+ (newline port)
+ (for-each
+ (lambda (session)
+ (for-each
+ (lambda (process)
+ (session-key->field session port)
+ (newline port)
+ (child-process->normalized-record process port)
+ (newline port)
+ (newline port))
+ (daemon-session-children session)))
+ sessions))
+
;;;
;;; Options.
@@ -205,7 +283,10 @@ active sessions, and the master 'guix-daemon' process."
(exit 0)))
(option '(#\V "version") #f #f
(lambda args
- (show-version-and-exit "guix processes")))))
+ (show-version-and-exit "guix processes")))
+ (option '("normalize") #f #f
+ (lambda (opt name arg result)
+ (alist-cons 'normalize #t result)))))
(define (show-help)
(display (G_ "Usage: guix processes
@@ -216,8 +297,13 @@ List the current Guix sessions and their processes."))
(display (G_ "
-V, --version display version information and exit"))
(newline)
+ (display (G_ "
+ --normalize display results as normalized record sets"))
+ (newline)
(show-bug-report-information))
+(define %default-options '())
+
;;;
;;; Entry point.
@@ -227,17 +313,12 @@ List the current Guix sessions and their processes."))
(category plumbing)
(synopsis "list currently running sessions")
(define options
- (args-fold* args %options
- (lambda (opt name arg result)
- (leave (G_ "~A: unrecognized option~%") name))
- cons
- '()))
+ (parse-command-line args %options (list %default-options)))
(with-paginated-output-port port
- (for-each (lambda (session)
- (daemon-session->recutils session port)
- (newline port))
- (daemon-sessions))
+ (match (assoc-ref options 'normalize)
+ (#t (format-normalized port))
+ (_ (format-single-record port)))
;; Pass 'R' (instead of 'r') so 'less' correctly estimates line length.
#:less-options "FRX"))
--
2.29.1