summaryrefslogtreecommitdiff
path: root/guix/store.scm
diff options
context:
space:
mode:
Diffstat (limited to 'guix/store.scm')
-rw-r--r--guix/store.scm32
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)
...