summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJohn Soo <jsoo1@asu.edu>2020-11-04 07:51:52 -0800
committerLudovic Courtès <ludo@gnu.org>2020-11-29 23:55:57 +0100
commit58be9e0bf1e58131e4e8d2b74f41b7b8e154b4b8 (patch)
tree3429aa3a0ca874662b64567e18a6a7c831963098
parente1c81203ca9aa8a6dedb7c539d3ff845626aadcc (diff)
processes: Add '--format' and the "normalized" format.
* guix/scripts/processes.scm (lock->recutils): New procedure. (daemon-session->recutils): Use it. (daemon-sessions->recutils, session-key->recutils) (session-scalars->normalized-record) (child-process->normalized-record) (daemon-sessions->normalized-record): New procedures. (session-rec-type, lock-rec-type, child-process-rec-type) (%available-formats): New variables. (list-formats): New procedure. (%options, show-help): Add '--format'. (%default-options): New variable. (guix-processes): Use 'parse-command-line' instead of 'args-fold*'. Honor the 'format' value in OPTIONS. * doc/guix.texi (Invoking guix processes): Document '--format'. Signed-off-by: Ludovic Courtès <ludo@gnu.org>
-rw-r--r--doc/guix.texi39
-rw-r--r--guix/scripts/processes.scm146
2 files changed, 166 insertions, 19 deletions
diff --git a/doc/guix.texi b/doc/guix.texi
index 7cef2371ad..e7277fc9ee 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -12899,6 +12899,45 @@ ClientPID: 19419
ClientCommand: cuirass --cache-directory /var/cache/cuirass @dots{}
@end example
+Additional options are listed below.
+
+@table @code
+@item --format=@var{format}
+@itemx -f @var{format}
+Produce output in the specified @var{format}, one of:
+
+@table @code
+@item recutils
+The default option. It outputs a set of Session recutils records
+that include each @code{ChildProcess} as a field.
+
+@item normalized
+Normalize the output records into record sets (@pxref{Record Sets,,,
+recutils, GNU recutils manual}). Normalizing into record sets allows
+joins across record types. The example below lists the PID of each
+@code{ChildProcess} and the associated PID for @code{Session} that
+spawned the @code{ChildProcess} where the @code{Session} was started
+using @command{guix build}.
+
+@example
+$ guix processes --format=normalized | \
+ recsel \
+ -j Session \
+ -t ChildProcess \
+ -p Session.PID,PID \
+ -e 'Session.ClientCommand ~ "guix build"'
+PID: 4435
+Session_PID: 4278
+
+PID: 4554
+Session_PID: 4278
+
+PID: 4646
+Session_PID: 4278
+@end example
+@end table
+@end table
+
@node System Configuration
@chapter System Configuration
diff --git a/guix/scripts/processes.scm b/guix/scripts/processes.scm
index 3a7ea0b89c..3db5603286 100644
--- a/guix/scripts/processes.scm
+++ b/guix/scripts/processes.scm
@@ -177,6 +177,9 @@ active sessions, and the master 'guix-daemon' process."
(values (filter-map child-process->session children)
master)))
+(define (lock->recutils 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~%"
@@ -185,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->recutils lock port))
(daemon-session-locks-held session))
(for-each (lambda (process)
(format port "ChildPID: ~a~%"
@@ -195,19 +197,102 @@ active sessions, and the master 'guix-daemon' process."
(process-command process)))
(daemon-session-children session)))
+(define (daemon-sessions->recutils port sessions)
+ "Display denormalized SESSIONS information to PORT."
+ (for-each (lambda (session)
+ (daemon-session->recutils session port)
+ (newline port))
+ sessions))
+
+(define session-rec-type
+ "%rec: Session
+%type: PID int
+%type: ClientPID int
+%key: PID
+%mandatory: ClientPID ClientCommand")
+
+(define lock-rec-type
+ "%rec: Lock
+%mandatory: LockHeld
+%type: Session rec Session")
+
+(define child-process-rec-type
+ "%rec: ChildProcess
+%type: PID int
+%type: Session rec Session
+%key: PID
+%mandatory: Command")
+
+(define (session-key->recutils session port)
+ "Display SESSION PID as a recutils 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 (daemon-sessions->normalized-record port sessions)
+ "Display SESSIONS recutils on PORT in normalized form"
+ (display session-rec-type port)
+ (newline port)
+ (newline port)
+ (for-each (lambda (session)
+ (session-scalars->normalized-record session port)
+ (newline port))
+ sessions)
+
+ (display lock-rec-type port)
+ (newline port)
+ (newline port)
+ (for-each (lambda (session)
+ (for-each (lambda (lock)
+ (lock->recutils "testing testing" port)
+ (session-key->recutils session port)
+ (newline port)
+ (newline port))
+ (daemon-session-locks-held session)))
+ sessions)
+
+ (display child-process-rec-type port)
+ (newline port)
+ (newline port)
+ (for-each (lambda (session)
+ (for-each (lambda (process)
+ (child-process->normalized-record process port)
+ (newline port)
+ (session-key->recutils session port)
+ (newline port)
+ (newline port))
+ (daemon-session-children session)))
+ sessions))
+
;;;
;;; Options.
;;;
-(define %options
- (list (option '(#\h "help") #f #f
- (lambda args
- (show-help)
- (exit 0)))
- (option '(#\V "version") #f #f
- (lambda args
- (show-version-and-exit "guix processes")))))
+(define %available-formats
+ '("recutils" "normalized"))
+
+(define (list-formats)
+ (display (G_ "The available formats are:\n"))
+ (newline)
+ (for-each (lambda (f)
+ (format #t " - ~a~%" f))
+ %available-formats))
(define (show-help)
(display (G_ "Usage: guix processes
@@ -218,8 +303,33 @@ List the current Guix sessions and their processes."))
(display (G_ "
-V, --version display version information and exit"))
(newline)
+ (display (G_ "
+ -f, --format=FORMAT display results as normalized record sets"))
+ (display (G_ "
+ --list-formats display available formats"))
+ (newline)
(show-bug-report-information))
+(define %options
+ (list (option '(#\h "help") #f #f
+ (lambda args
+ (show-help)
+ (exit 0)))
+ (option '(#\V "version") #f #f
+ (lambda args
+ (show-version-and-exit "guix processes")))
+ (option '(#\f "format") #t #f
+ (lambda (opt name arg result)
+ (unless (member arg %available-formats)
+ (leave (G_ "~a: unsupported output format~%") arg))
+ (alist-cons 'format (string->symbol arg) result)))
+ (option '("list-formats") #f #f
+ (lambda (opt name arg result)
+ (list-formats)
+ (exit 0)))))
+
+(define %default-options '((format . recutils)))
+
;;;
;;; Entry point.
@@ -228,18 +338,16 @@ List the current Guix sessions and their processes."))
(define-command (guix-processes . args)
(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)
+ #:build-options? #f))
(with-paginated-output-port port
- (for-each (lambda (session)
- (daemon-session->recutils session port)
- (newline port))
- (daemon-sessions))
+ (match (assoc-ref options 'format)
+ ('normalized
+ (daemon-sessions->normalized-record port (daemon-sessions)))
+ (_ (daemon-sessions->recutils port (daemon-sessions))))
;; Pass 'R' (instead of 'r') so 'less' correctly estimates line length.
#:less-options "FRX"))