summaryrefslogtreecommitdiff
path: root/gnu/build
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-09-29 12:02:09 +0200
committerLudovic Courtès <ludo@gnu.org>2020-09-29 21:56:27 +0200
commitd5366500ec1aeecad6fc292b195088e30aa715fd (patch)
tree21673b5d3103d797bec4e54473e6824528312139 /gnu/build
parent59261a22f9819b1fdf797ffba17af17d385d6c92 (diff)
secret-service: Add proper logging procedure and log to syslog.
* gnu/build/secret-service.scm (log): New macro. (secret-service-send-secrets, secret-service-receive-secrets): Use it instead of raw 'format' calls.
Diffstat (limited to 'gnu/build')
-rw-r--r--gnu/build/secret-service.scm62
1 files changed, 29 insertions, 33 deletions
diff --git a/gnu/build/secret-service.scm b/gnu/build/secret-service.scm
index 2cc59e0ee1..46dcf1b9c3 100644
--- a/gnu/build/secret-service.scm
+++ b/gnu/build/secret-service.scm
@@ -35,6 +35,18 @@
;;;
;;; Code:
+(define-syntax log
+ (lambda (s)
+ "Log the given message."
+ (syntax-case s ()
+ ((_ fmt args ...)
+ (with-syntax ((fmt (string-append "secret service: "
+ (syntax->datum #'fmt))))
+ ;; Log to the current output port. That way, when
+ ;; 'secret-service-send-secrets' is called from shepherd, output goes
+ ;; to syslog.
+ #'(format (current-output-port) fmt args ...))))))
+
(define* (secret-service-send-secrets port secret-root
#:key (retry 60)
(handshake-timeout 120))
@@ -60,7 +72,7 @@ wait for at most HANDSHAKE-TIMEOUT seconds for handshake to complete. Return
(dump-port input sock))))
files)))
- (format (current-error-port) "sending secrets to ~a~%" port)
+ (log "sending secrets to ~a~%" port)
(let ((sock (socket AF_INET SOCK_STREAM 0))
(addr (make-socket-address AF_INET INADDR_LOOPBACK port)))
;; Connect to QEMU on the forwarded port. The 'connect' call succeeds as
@@ -72,14 +84,12 @@ wait for at most HANDSHAKE-TIMEOUT seconds for handshake to complete. Return
(lambda (key . args)
(when (zero? retry)
(apply throw key args))
- (format (current-error-port)
- "secret service: retrying connection [~a attempts left]~%"
- (- retry 1))
+ (log "retrying connection [~a attempts left]~%"
+ (- retry 1))
(sleep 1)
(loop (1- retry)))))
- (format (current-error-port)
- "secret service: connected; waiting for handshake...~%")
+ (log "connected; waiting for handshake...~%")
;; Wait for "hello" message from the server. This is the only way to know
;; that we're really connected to the server inside the guest.
@@ -87,25 +97,17 @@ wait for at most HANDSHAKE-TIMEOUT seconds for handshake to complete. Return
(((_) () ())
(match (read sock)
(('secret-service-server ('version version ...))
- (format (current-error-port)
- "secret service: sending files from ~s...~%"
- secret-root)
+ (log "sending files from ~s...~%" secret-root)
(send-files sock)
- (format (current-error-port)
- "secret service: done sending files to port ~a~%"
- port)
+ (log "done sending files to port ~a~%" port)
(close-port sock)
secret-root)
(x
- (format (current-error-port)
- "secret service: invalid handshake ~s~%"
- x)
+ (log "invalid handshake ~s~%" x)
(close-port sock)
#f)))
((() () ()) ;timeout
- (format (current-error-port)
- "secret service: timeout while sending files to ~a~%"
- port)
+ (log "timeout while sending files to ~a~%" port)
(close-port sock)
#f))))
@@ -121,17 +123,14 @@ and #f otherwise."
(let ((sock (socket AF_INET SOCK_STREAM 0)))
(bind sock AF_INET INADDR_ANY port)
(listen sock 1)
- (format (current-error-port)
- "secret service: waiting for secrets on port ~a...~%"
- port)
+ (log "waiting for secrets on port ~a...~%" port)
(match (select (list sock) '() '() 60)
(((_) () ())
(match (accept sock)
((client . address)
- (format (current-error-port)
- "secret service: client connection from ~a~%"
- (inet-ntop (sockaddr:fam address)
- (sockaddr:addr address)))
+ (log "client connection from ~a~%"
+ (inet-ntop (sockaddr:fam address)
+ (sockaddr:addr address)))
;; Send a "hello" message. This allows the client running on the
;; host to know that it's now actually connected to server running
@@ -141,8 +140,7 @@ and #f otherwise."
(close-port sock)
client)))
((() () ())
- (format (current-error-port)
- "secret service: did not receive any secrets; time out~%")
+ (log "did not receive any secrets; time out~%")
(close-port sock)
#f))))
@@ -169,20 +167,18 @@ and #f otherwise."
(('secrets ('version 0)
('files ((files sizes modes) ...)))
(for-each (lambda (file size mode)
- (format (current-error-port)
- "secret service: \
-installing file '~a' (~a bytes)...~%"
- file size)
+ (log "installing file '~a' (~a bytes)...~%"
+ file size)
(mkdir-p (dirname file))
(call-with-output-file file
(lambda (output)
(dump port output size)
(chmod file mode))))
files sizes modes)
+ (log "received ~a secret files~%" (length files))
files)
(_
- (format (current-error-port)
- "secret service: invalid secrets received~%")
+ (log "invalid secrets received~%")
#f)))
(let* ((port (wait-for-client port))