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>
This commit is contained in:
John Soo
Ludovic Courtès
parent
e1c81203ca
commit
58be9e0bf1
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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"))
|
||||
|
|
|
|||
Loading…
Reference in New Issue