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

secret-service: Add proper logging procedure and log to syslog.

Browse source 
* gnu/build/secret-service.scm (log): New macro.
(secret-service-send-secrets, secret-service-receive-secrets): Use it
instead of raw 'format' calls.
This commit is contained in:
Ludovic Courtès 2020-09-29 12:02:09 +02:00
parent 59261a22f9
commit d5366500ec
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 29 additions and 33 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

54
gnu/build/secret-service.scm
View file

@ -35,6 +35,18 @@ (define-module (gnu build secret-service)
;;;
;;; 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 @@ (define (send-files sock)
(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 @@ (define (send-files sock)
(lambda (key . args)
(when (zero? retry)
(apply throw key args))
(format (current-error-port)
"secret service: retrying connection [~a attempts left]~%"
(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 @@ (define (send-files sock)
(((_) () ())
(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,15 +123,12 @@ (define (wait-for-client port)
(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~%"
(log "client connection from ~a~%"
(inet-ntop (sockaddr:fam address)
(sockaddr:addr address)))
@ -141,8 +140,7 @@ (define (wait-for-client port)
(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,9 +167,7 @@ (define (read-secrets port)
(('secrets ('version 0)
('files ((files sizes modes) ...)))
(for-each (lambda (file size mode)
(format (current-error-port)
"secret service: \
installing file '~a' (~a bytes)...~%"
(log "installing file '~a' (~a bytes)...~%"
file size)
(mkdir-p (dirname file))
(call-with-output-file file
@ -179,10 +175,10 @@ (define (read-secrets port)
(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))