ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

Add 'guix processes'.

Browse source 
* guix/scripts/processes.scm, tests/processes.scm: New files.
* Makefile.am (MODULES): Add the former.
(SCM_TESTS): Add the latter.
* po/guix/POTFILES.in: Add guix/scripts/processes.scm.
* doc/guix.texi (Invoking guix processes): New node.
(Invoking guix-daemon): Reference it.
This commit is contained in:
Ludovic Courtès 2018-10-26 11:20:08 +02:00
parent b4c93a78c8
commit 63eb2b899b
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
5 changed files with 375 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
Makefile.am
View file

@ -201,6 +201,7 @@ MODULES = \
guix/scripts/hash.scm \
guix/scripts/pack.scm \
guix/scripts/pull.scm \
guix/scripts/processes.scm \
guix/scripts/substitute.scm \
guix/scripts/authenticate.scm \
guix/scripts/refresh.scm \
@ -343,6 +344,7 @@ SCM_TESTS = \
tests/ui.scm \
tests/status.scm \
tests/records.scm \
tests/processes.scm \
tests/upstream.scm \
tests/combinators.scm \
tests/discovery.scm \

63
doc/guix.texi
View file

@ -194,6 +194,7 @@ Utilities
* Invoking guix copy:: Copying to and from a remote store.
* Invoking guix container:: Process isolation.
* Invoking guix weather:: Assessing substitute availability.
* Invoking guix processes:: Listing client processes.
Invoking @command{guix build}
@ -1239,6 +1240,12 @@ The build directory is automatically deleted upon completion, unless the
build failed and the client specified @option{--keep-failed}
(@pxref{Invoking guix build, @option{--keep-failed}}).
The daemon listens for connections and spawns one sub-process for each session
started by a client (one of the @command{guix} sub-commands.) The
@command{guix processes} command allows you to get an overview of the activity
on your system by viewing each of the active sessions and clients.
@xref{Invoking guix processes}, for more information.
The following command-line options are supported:
@table @code
@ -6052,6 +6059,7 @@ the Scheme programming interface of Guix in a convenient way.
* Invoking guix copy:: Copying to and from a remote store.
* Invoking guix container:: Process isolation.
* Invoking guix weather:: Assessing substitute availability.
* Invoking guix processes:: Listing client processes.
@end menu
@node Invoking guix build
@ -8752,6 +8760,61 @@ with the @code{-m} option of @command{guix package} (@pxref{Invoking
guix package}).
@end table
@node Invoking guix processes
@section Invoking @command{guix processes}
The @command{guix processes} command can be useful to developers and system
administrators, especially on multi-user machines and on build farms: it lists
the current sessions (connections to the daemon), as well as information about
the processes involved@footnote{Remote sessions, when @command{guix-daemon} is
started with @option{--listen} specifying a TCP endpoint, are @emph{not}
listed.}. Here's an example of the information it returns:
@example
$ sudo guix processes
SessionPID: 19002
ClientPID: 19090
ClientCommand: guix environment --ad-hoc python
SessionPID: 19402
ClientPID: 19367
ClientCommand: guix publish -u guix-publish -p 3000 -C 9 @dots{}
SessionPID: 19444
ClientPID: 19419
ClientCommand: cuirass --cache-directory /var/cache/cuirass @dots{}
LockHeld: /gnu/store/@dots{}-perl-ipc-cmd-0.96.lock
LockHeld: /gnu/store/@dots{}-python-six-bootstrap-1.11.0.lock
LockHeld: /gnu/store/@dots{}-libjpeg-turbo-2.0.0.lock
ChildProcess: 20495: guix offload x86_64-linux 7200 1 28800
ChildProcess: 27733: guix offload x86_64-linux 7200 1 28800
ChildProcess: 27793: guix offload x86_64-linux 7200 1 28800
@end example
In this example we see that @command{guix-daemon} has three clients:
@command{guix environment}, @command{guix publish}, and the Cuirass continuous
integration tool; their process identifier (PID) is given by the
@code{ClientPID} field. The @code{SessionPID} field gives the PID of the
@command{guix-daemon} sub-process of this particular session.
The @code{LockHeld} fields show which store items are currently locked by this
session, which corresponds to store items being built or substituted (the
@code{LockHeld} field is not displayed when @command{guix processes} is not
running as root.) Last, by looking at the @code{ChildProcess} field, we
understand that these three builds are being offloaded (@pxref{Daemon Offload
Setup}).
The output is in Recutils format so we can use the handy @command{recsel}
command to select sessions of interest (@pxref{Selection Expressions,,,
recutils, GNU recutils manual}). As an example, the command shows the command
line and PID of the client that triggered the build of a Perl package:
@example
$ sudo guix processes | \
recsel -p ClientPID,ClientCommand -e 'LockHeld ~ "perl"'
ClientPID: 19419
ClientCommand: cuirass --cache-directory /var/cache/cuirass @dots{}
@end example
@c *********************************************************************
@node GNU Distribution

223
guix/scripts/processes.scm Normal file
View file

@ -0,0 +1,223 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix scripts processes)
#:use-module ((guix store) #:select (%store-prefix))
#:use-module (guix scripts)
#:use-module (guix ui)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-9 gnu)
#:use-module (srfi srfi-37)
#:use-module (ice-9 ftw)
#:use-module (ice-9 match)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 format)
#:export (process?
process-id
process-parent-id
process-command
processes
daemon-session?
daemon-session-process
daemon-session-client
daemon-session-children
daemon-session-locks-held
daemon-sessions
guix-processes))
;; Process as can be found in /proc on GNU/Linux.
(define-record-type <process>
(process id parent command)
process?
(id process-id) ;integer
(parent process-parent-id) ;integer | #f
(command process-command)) ;list of strings
(define (write-process process port)
(format port "#<process ~a>" (process-id process)))
(set-record-type-printer! <process> write-process)
(define (read-status-ppid port)
"Read the PPID from PORT, an input port on a /proc/PID/status file. Return
#f for PID 1 and kernel pseudo-processes."
(let loop ()
(match (read-line port)
((? eof-object?) #f)
(line
(if (string-prefix? "PPid:" line)
(string->number (string-trim-both (string-drop line 5)))
(loop))))))
(define %not-nul
(char-set-complement (char-set #\nul)))
(define (read-command-line port)
"Read the zero-split command line from PORT, a /proc/PID/cmdline file, and
return it as a list."
(string-tokenize (read-string port) %not-nul))
(define (processes)
"Return a list of process records representing the currently alive
processes."
;; This assumes a Linux-compatible /proc file system. There exists one for
;; GNU/Hurd.
(filter-map (lambda (pid)
;; There's a TOCTTOU race here. If we get ENOENT, simply
;; ignore PID.
(catch 'system-error
(lambda ()
(define ppid
(call-with-input-file (string-append "/proc/" pid "/status")
read-status-ppid))
(define command
(call-with-input-file (string-append "/proc/" pid "/cmdline")
read-command-line))
(process (string->number pid) ppid command))
(lambda args
(if (= ENOENT (system-error-errno args))
#f
(apply throw args)))))
(scandir "/proc" string->number)))
(define (process-open-files process)
"Return the list of files currently open by PROCESS."
(let ((directory (string-append "/proc/"
(number->string (process-id process))
"/fd")))
(map (lambda (fd)
(readlink (string-append directory "/" fd)))
(or (scandir directory string->number) '()))))
;; Daemon session.
(define-record-type <daemon-session>
(daemon-session process client children locks)
daemon-session?
(process daemon-session-process) ;<process>
(client daemon-session-client) ;<process>
(children daemon-session-children) ;list of <process>
(locks daemon-session-locks-held)) ;list of strings
(define (daemon-sessions)
"Return two values: the list of <daemon-session> denoting the currently
active sessions, and the master 'guix-daemon' process."
(define (lock-file? file)
(and (string-prefix? (%store-prefix) file)
(string-suffix? ".lock" file)))
(let* ((processes (processes))
(daemons (filter (lambda (process)
(match (process-command process)
((argv0 _ ...)
(string=? (basename argv0) "guix-daemon"))
(_ #f)))
processes))
(children (filter (lambda (process)
(match (process-command process)
((argv0 (= string->number argv1) _ ...)
(integer? argv1))
(_ #f)))
daemons))
(master (remove (lambda (process)
(memq process children))
daemons)))
(define (lookup-process pid)
(find (lambda (process)
(and (process-id process)
(= pid (process-id process))))
processes))
(define (lookup-children pid)
(filter (lambda (process)
(and (process-parent-id process)
(= pid (process-parent-id process))))
processes))
(values (map (lambda (process)
(match (process-command process)
((argv0 (= string->number client) _ ...)
(let ((files (process-open-files process)))
(daemon-session process
(lookup-process client)
(lookup-children (process-id process))
(filter lock-file? files))))))
children)
master)))
(define (daemon-session->recutils session port)
"Display SESSION information in recutils format on PORT."
(format port "SessionPID: ~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)))
(for-each (lambda (lock)
(format port "LockHeld: ~a~%" lock))
(daemon-session-locks-held session))
(for-each (lambda (process)
(format port "ChildProcess: ~a:~{ ~a~}~%"
(process-id process)
(process-command process)))
(daemon-session-children session)))
;;;
;;; 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 (show-help)
(display (G_ "Usage: guix processes
List the current Guix sessions and their processes."))
(newline)
(display (G_ "
-h, --help display this help and exit"))
(display (G_ "
-V, --version display version information and exit"))
(newline)
(show-bug-report-information))
;;;
;;; Entry point.
;;;
(define (guix-processes . args)
(define options
(args-fold* args %options
(lambda (opt name arg result)
(leave (G_ "~A: unrecognized option~%") name))
cons
'()))
(for-each (lambda (session)
(daemon-session->recutils session (current-output-port))
(newline))
(daemon-sessions)))

1
po/guix/POTFILES.in
View file

@ -32,6 +32,7 @@ guix/scripts/copy.scm
guix/scripts/pack.scm
guix/scripts/weather.scm
guix/scripts/describe.scm
guix/scripts/processes.scm
guix/gnu-maintenance.scm
guix/scripts/container.scm
guix/scripts/container/exec.scm

86
tests/processes.scm Normal file
View file

@ -0,0 +1,86 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (test-processes)
#:use-module (guix scripts processes)
#:use-module (guix store)
#:use-module (guix derivations)
#:use-module (guix packages)
#:use-module (guix gexp)
#:use-module ((guix utils) #:select (call-with-temporary-directory))
#:use-module (gnu packages bootstrap)
#:use-module (guix tests)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-64)
#:use-module (rnrs bytevectors)
#:use-module (rnrs io ports)
#:use-module (ice-9 match)
#:use-module (ice-9 threads))
(test-begin "processes")
(test-assert "not a client"
(not (find (lambda (session)
(= (getpid)
(process-id (daemon-session-client session))))
(daemon-sessions))))
(test-assert "client"
(with-store store
(let* ((session (find (lambda (session)
(= (getpid)
(process-id (daemon-session-client session))))
(daemon-sessions)))
(daemon (daemon-session-process session)))
(and (kill (process-id daemon) 0)
(string-suffix? "guix-daemon" (first (process-command daemon)))))))
(test-assert "client + lock"
(with-store store
(call-with-temporary-directory
(lambda (directory)
(let* ((token1 (string-append directory "/token1"))
(token2 (string-append directory "/token2"))
(exp #~(begin #$(random-text)
(mkdir #$token1)
(let loop ()
(unless (file-exists? #$token2)
(sleep 1)
(loop)))
(mkdir #$output)))
(guile (package-derivation store %bootstrap-guile))
(drv (run-with-store store
(gexp->derivation "foo" exp
#:guile-for-build guile)))
(thread (call-with-new-thread
(lambda ()
(build-derivations store (list drv)))))
(_ (let loop ()
(unless (file-exists? token1)
(usleep 200)
(loop))))
(session (find (lambda (session)
(= (getpid)
(process-id (daemon-session-client session))))
(daemon-sessions)))
(locks (daemon-session-locks-held (pk 'session session))))
(call-with-output-file token2 (const #t))
(equal? (list (string-append (derivation->output-path drv) ".lock"))
locks))))))
(test-end "processes")