ssh: Honor GUIX_DAEMON_SOCKET on the target machine.
Fixes <https://bugs.gnu.org/48240>. Reported by Ricardo Wurmus <rekado@elephly.net>. * guix/ssh.scm (remote-daemon-channel)[redirect]: Define 'connect-to-daemon'. Use the same-named procedure from (guix store) when available, and honor GUIX_DAEMON_SOCKET.
This commit is contained in:
parent
dd14678b9b
commit
3270308eeb
21
guix/ssh.scm
21
guix/ssh.scm
@ -1,5 +1,5 @@
|
|||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2016, 2017, 2018, 2019, 2020, 2021, 2021 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
@ -253,7 +253,22 @@ EXP never returns or calls 'primitive-exit' when it's done."
|
|||||||
(use-modules (ice-9 match) (rnrs io ports)
|
(use-modules (ice-9 match) (rnrs io ports)
|
||||||
(rnrs bytevectors))
|
(rnrs bytevectors))
|
||||||
|
|
||||||
(let ((sock (socket AF_UNIX SOCK_STREAM 0))
|
(define connect-to-daemon
|
||||||
|
;; XXX: 'connect-to-daemon' used to be private and before that it
|
||||||
|
;; didn't even exist, hence these shenanigans.
|
||||||
|
(let ((connect-to-daemon
|
||||||
|
(false-if-exception (module-ref (resolve-module '(guix store))
|
||||||
|
'connect-to-daemon))))
|
||||||
|
(lambda (uri)
|
||||||
|
(if connect-to-daemon
|
||||||
|
(connect-to-daemon uri)
|
||||||
|
(let ((sock (socket AF_UNIX SOCK_STREAM 0)))
|
||||||
|
(connect sock AF_UNIX ,socket-name)
|
||||||
|
sock)))))
|
||||||
|
|
||||||
|
;; Use 'connect-to-daemon' to honor GUIX_DAEMON_SOCKET.
|
||||||
|
(let ((sock (connect-to-daemon (or (getenv "GUIX_DAEMON_SOCKET")
|
||||||
|
socket-name)))
|
||||||
(stdin (current-input-port))
|
(stdin (current-input-port))
|
||||||
(stdout (current-output-port))
|
(stdout (current-output-port))
|
||||||
(select* (lambda (read write except)
|
(select* (lambda (read write except)
|
||||||
@ -272,8 +287,6 @@ EXP never returns or calls 'primitive-exit' when it's done."
|
|||||||
(setvbuf stdin 'block 65536)
|
(setvbuf stdin 'block 65536)
|
||||||
(setvbuf sock 'block 65536)
|
(setvbuf sock 'block 65536)
|
||||||
|
|
||||||
(connect sock AF_UNIX ,socket-name)
|
|
||||||
|
|
||||||
(let loop ()
|
(let loop ()
|
||||||
(match (select* (list stdin sock) '() '())
|
(match (select* (list stdin sock) '() '())
|
||||||
((reads () ())
|
((reads () ())
|
||||||
|
Loading…
Reference in New Issue
Block a user