diff options
author | Ludovic Courtès <ludovic.courtes@inria.fr> | 2017-06-16 14:23:51 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2017-06-16 17:08:22 +0200 |
commit | f4453df9a5742ef47cad79254b33bfaa1ff15d24 (patch) | |
tree | e4f598aa498511524059fc01bdcf1ad3fb2d8d62 /guix/store.scm | |
parent | d27cc3bfaafe6b5b0831e88afb1c46311d382a0b (diff) | |
download | gnu-guix-f4453df9a5742ef47cad79254b33bfaa1ff15d24.tar gnu-guix-f4453df9a5742ef47cad79254b33bfaa1ff15d24.tar.gz |
store: Add an RPC counter.
* guix/store.scm (%rpc-calls): New variable.
(show-rpc-profile, record-operation): New procedures.
(operation): Add call to 'record-operation'.
* guix/ui.scm (run-guix-command): Wrap COMMAND-MAIN in 'dynamic-wind'.
Run EXIT-HOOK.
Diffstat (limited to 'guix/store.scm')
-rw-r--r-- | guix/store.scm | 32 |
1 files changed, 32 insertions, 0 deletions
diff --git a/guix/store.scm b/guix/store.scm index ed588aae47..2acab6b1a3 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -718,6 +718,37 @@ encoding conversion errors." (let loop ((done? (process-stderr server))) (or done? (process-stderr server))))) +(define %rpc-calls + ;; Mapping from RPC names (symbols) to invocation counts. + (make-hash-table)) + +(define* (show-rpc-profile #:optional (port (current-error-port))) + "Write to PORT a summary of the RPCs that have been made." + (let ((profile (sort (hash-fold alist-cons '() %rpc-calls) + (lambda (rpc1 rpc2) + (< (cdr rpc1) (cdr rpc2)))))) + (format port "Remote procedure call summary: ~a RPCs~%" + (match profile + (((names . counts) ...) + (reduce + 0 counts)))) + (for-each (match-lambda + ((rpc . count) + (format port " ~30a ... ~5@a~%" rpc count))) + profile))) + +(define record-operation + ;; Optionally, increment the number of calls of the given RPC. + (let ((profiled (or (and=> (getenv "GUIX_PROFILING") string-tokenize) + '()))) + (if (member "rpc" profiled) + (begin + (add-hook! exit-hook show-rpc-profile) + (lambda (name) + (let ((count (or (hashq-ref %rpc-calls name) 0))) + (hashq-set! %rpc-calls name (+ count 1))))) + (lambda (_) + #t)))) + (define-syntax operation (syntax-rules () "Define a client-side RPC stub for the given operation." @@ -725,6 +756,7 @@ encoding conversion errors." (lambda (server arg ...) docstring (let ((s (nix-server-socket server))) + (record-operation 'name) (write-int (operation-id name) s) (write-arg type arg s) ... |