[jackhill/guix/guix.git] / guix / ssh.scm

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (guix ssh)
  #:use-module (guix store)
  #:use-module ((guix ui) #:select (G_ N_))
  #:use-module (ssh session)
  #:use-module (ssh auth)
  #:use-module (ssh key)
  #:use-module (ssh channel)
  #:use-module (ssh popen)
  #:use-module (ssh session)
  #:use-module (ssh dist)
  #:use-module (ssh dist node)
  #:use-module (srfi srfi-11)
  #:use-module (srfi srfi-34)
  #:use-module (srfi srfi-35)
  #:use-module (ice-9 match)
  #:use-module (ice-9 binary-ports)
  #:export (open-ssh-session
            remote-daemon-channel
            connect-to-remote-daemon
            send-files
            retrieve-files
            remote-store-host

            file-retrieval-port))

;;; Commentary:
;;;
;;; This module provides tools to support communication with remote stores
;;; over SSH, using Guile-SSH.
;;;
;;; Code:

(define %compression
  "zlib@openssh.com,zlib")

(define* (open-ssh-session host #:key user port
                           (compression %compression))
  "Open an SSH session for HOST and return it.  When USER and PORT are #f, use
default values or whatever '~/.ssh/config' specifies; otherwise use them.
Throw an error on failure."
  (let ((session (make-session #:user user
                               #:host host
                               #:port port
                               #:timeout 10       ;seconds
                               ;; #:log-verbosity 'protocol

                               ;; We need lightweight compression when
                               ;; exchanging full archives.
                               #:compression compression
                               #:compression-level 3)))

    ;; Honor ~/.ssh/config.
    (session-parse-config! session)

    (match (connect! session)
      ('ok
       ;; Use public key authentication, via the SSH agent if it's available.
       (match (userauth-public-key/auto! session)
         ('success
          session)
         (x
          (disconnect! session)
          (raise (condition
                  (&message
                   (message (format #f (G_ "SSH authentication failed for '~a': ~a~%")
                                    host (get-error session)))))))))
      (x
       ;; Connection failed or timeout expired.
       (raise (condition
               (&message
                (message (format #f (G_ "SSH connection to '~a' failed: ~a~%")
                                 host (get-error session))))))))))

(define* (remote-daemon-channel session
                                #:optional
                                (socket-name
                                 "/var/guix/daemon-socket/socket"))
  "Return an input/output port (an SSH channel) to the daemon at SESSION."
  (define redirect
    ;; Code run in SESSION to redirect the remote process' stdin/stdout to the
    ;; daemon's socket, à la socat.  The SSH protocol supports forwarding to
    ;; Unix-domain sockets but libssh doesn't have an API for that, hence this
    ;; hack.
    `(begin
       (use-modules (ice-9 match) (rnrs io ports))

       (let ((sock   (socket AF_UNIX SOCK_STREAM 0))
             (stdin  (current-input-port))
             (stdout (current-output-port)))
         (setvbuf stdin _IONBF)
         (setvbuf stdout _IONBF)
         (connect sock AF_UNIX ,socket-name)

         (let loop ()
           (match (select (list stdin sock) '() (list stdin stdout sock))
             ((reads writes ())
              (when (memq stdin reads)
                (match (get-bytevector-some stdin)
                  ((? eof-object?)
                   (primitive-exit 0))
                  (bv
                   (put-bytevector sock bv))))
              (when (memq sock reads)
                (match (get-bytevector-some sock)
                  ((? eof-object?)
                   (primitive-exit 0))
                  (bv
                   (put-bytevector stdout bv))))
              (loop))
             (_
              (primitive-exit 1)))))))

  (open-remote-pipe* session OPEN_BOTH
                     ;; Sort-of shell-quote REDIRECT.
                     "guile" "-c"
                     (object->string
                      (object->string redirect))))

(define* (connect-to-remote-daemon session
                                   #:optional
                                   (socket-name
                                    "/var/guix/daemon-socket/socket"))
  "Connect to the remote build daemon listening on SOCKET-NAME over SESSION,
an SSH session.  Return a <nix-server> object."
  (open-connection #:port (remote-daemon-channel session)))


(define (store-import-channel session)
  "Return an output port to which archives to be exported to SESSION's store
can be written."
  ;; Using the 'import-paths' RPC on a remote store would be slow because it
  ;; makes a round trip every time 32 KiB have been transferred.  This
  ;; procedure instead opens a separate channel to use the remote
  ;; 'import-paths' procedure, which consumes all the data in a single round
  ;; trip.
  (define import
    `(begin
       (use-modules (guix))

       (with-store store
         (setvbuf (current-input-port) _IONBF)

         ;; FIXME: Exceptions are silently swallowed.  We should report them
         ;; somehow.
         (import-paths store (current-input-port)))))

  (open-remote-output-pipe session
                           (string-join
                            `("guile" "-c"
                              ,(object->string
                                (object->string import))))))

(define* (store-export-channel session files
                               #:key recursive?)
  "Return an input port from which an export of FILES from SESSION's store can
be read.  When RECURSIVE? is true, the closure of FILES is exported."
  ;; Same as above: this is more efficient than calling 'export-paths' on a
  ;; remote store.
  (define export
    `(begin
       (use-modules (guix))

       (with-store store
         (setvbuf (current-output-port) _IONBF)

         ;; FIXME: Exceptions are silently swallowed.  We should report them
         ;; somehow.
         (export-paths store ',files (current-output-port)
                       #:recursive? ,recursive?))))

  (open-remote-input-pipe session
                          (string-join
                           `("guile" "-c"
                             ,(object->string
                               (object->string export))))))

(define* (send-files local files remote
                     #:key
                     recursive?
                     (log-port (current-error-port)))
  "Send the subset of FILES from LOCAL (a local store) that's missing to
REMOTE, a remote store.  When RECURSIVE? is true, send the closure of FILES.
Return the list of store items actually sent."
  ;; Compute the subset of FILES missing on SESSION and send them.
  (let* ((files   (if recursive? (requisites local files) files))
         (session (channel-get-session (nix-server-socket remote)))
         (node    (make-node session))
         (missing (node-eval node
                             `(begin
                                (use-modules (guix)
                                             (srfi srfi-1) (srfi srfi-26))

                                (with-store store
                                  (remove (cut valid-path? store <>)
                                          ',files)))))
         (count   (length missing))
         (port    (store-import-channel session)))
    (format log-port (N_ "sending ~a store item to '~a'...~%"
                         "sending ~a store items to '~a'...~%" count)
            count (session-get session 'host))

    ;; Send MISSING in topological order.
    (export-paths local missing port)

    ;; Tell the remote process that we're done.  (In theory the end-of-archive
    ;; mark of 'export-paths' would be enough, but in practice it's not.)
    (channel-send-eof port)

    ;; Wait for completion of the remote process.
    (let ((result (zero? (channel-get-exit-status port))))
      (close-port port)
      missing)))

(define (remote-store-session remote)
  "Return the SSH channel beneath REMOTE, a remote store as returned by
'connect-to-remote-daemon', or #f."
  (channel-get-session (nix-server-socket remote)))

(define (remote-store-host remote)
  "Return the name of the host REMOTE is connected to, where REMOTE is a
remote store as returned by 'connect-to-remote-daemon'."
  (match (remote-store-session remote)
    (#f #f)
    ((? session? session)
     (session-get session 'host))))

(define* (file-retrieval-port files remote
                              #:key recursive?)
  "Return an input port from which to retrieve FILES (a list of store items)
from REMOTE, along with the number of items to retrieve (lower than or equal
to the length of FILES.)"
  (values (store-export-channel (remote-store-session remote) files
                                #:recursive? recursive?)
          (length files)))            ;XXX: inaccurate when RECURSIVE? is true

(define* (retrieve-files local files remote
                         #:key recursive? (log-port (current-error-port)))
  "Retrieve FILES from REMOTE and import them using the 'import-paths' RPC on
LOCAL.  When RECURSIVE? is true, retrieve the closure of FILES."
  (let-values (((port count)
                (file-retrieval-port files remote
                                     #:recursive? recursive?)))
    (format #t (N_ "retrieving ~a store item from '~a'...~%"
                   "retrieving ~a store items from '~a'...~%" count)
            count (remote-store-host remote))
    (when (eof-object? (lookahead-u8 port))
      ;; The failure could be because one of the requested store items is not
      ;; valid on REMOTE, or because Guile or Guix is improperly installed.
      ;; TODO: Improve error reporting.
      (raise (condition
              (&message
               (message
                (format #f
                        (G_ "failed to retrieve store items from '~a'")
                        (remote-store-host remote)))))))

    (let ((result (import-paths local port)))
      (close-port port)
      result)))

;;; ssh.scm ends here
Commit	Line	Data
987a29ba	1	;;; GNU Guix --- Functional package management for GNU
615c5298	2	;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
987a29ba LC	3	;;;
	4	;;; This file is part of GNU Guix.
	5	;;;
	6	;;; GNU Guix is free software; you can redistribute it and/or modify it
	7	;;; under the terms of the GNU General Public License as published by
	8	;;; the Free Software Foundation; either version 3 of the License, or (at
	9	;;; your option) any later version.
	10	;;;
	11	;;; GNU Guix is distributed in the hope that it will be useful, but
	12	;;; WITHOUT ANY WARRANTY; without even the implied warranty of
	13	;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	14	;;; GNU General Public License for more details.
	15	;;;
	16	;;; You should have received a copy of the GNU General Public License
	17	;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
	18
	19	(define-module (guix ssh)
	20	#:use-module (guix store)
69daee23	21	#:use-module ((guix ui) #:select (G_ N_))
615c5298 LC	22	#:use-module (ssh session)
	23	#:use-module (ssh auth)
	24	#:use-module (ssh key)
987a29ba LC	25	#:use-module (ssh channel)
	26	#:use-module (ssh popen)
	27	#:use-module (ssh session)
	28	#:use-module (ssh dist)
	29	#:use-module (ssh dist node)
	30	#:use-module (srfi srfi-11)
13164a21 LC	31	#:use-module (srfi srfi-34)
13164a21 LC	32	#:use-module (srfi srfi-35)
987a29ba	33	#:use-module (ice-9 match)
13164a21	34	#:use-module (ice-9 binary-ports)
615c5298	35	#:export (open-ssh-session
e5378337	36	remote-daemon-channel
615c5298	37	connect-to-remote-daemon
987a29ba LC	38	send-files
	39	retrieve-files
	40	remote-store-host
	41
	42	file-retrieval-port))
	43
	44	;;; Commentary:
	45	;;;
	46	;;; This module provides tools to support communication with remote stores
	47	;;; over SSH, using Guile-SSH.
	48	;;;
	49	;;; Code:
	50
615c5298 LC	51	(define %compression
	52	"zlib@openssh.com,zlib")
	53
	54	(define* (open-ssh-session host #:key user port
	55	(compression %compression))
	56	"Open an SSH session for HOST and return it. When USER and PORT are #f, use
	57	default values or whatever '~/.ssh/config' specifies; otherwise use them.
	58	Throw an error on failure."
	59	(let ((session (make-session #:user user
	60	#:host host
	61	#:port port
	62	#:timeout 10 ;seconds
	63	;; #:log-verbosity 'protocol
	64
	65	;; We need lightweight compression when
	66	;; exchanging full archives.
	67	#:compression compression
	68	#:compression-level 3)))
	69
	70	;; Honor ~/.ssh/config.
	71	(session-parse-config! session)
	72
	73	(match (connect! session)
	74	('ok
	75	;; Use public key authentication, via the SSH agent if it's available.
	76	(match (userauth-public-key/auto! session)
	77	('success
	78	session)
	79	(x
	80	(disconnect! session)
	81	(raise (condition
	82	(&message
69daee23	83	(message (format #f (G_ "SSH authentication failed for '~a': ~a~%")
615c5298 LC	84	host (get-error session)))))))))
	85	(x
	86	;; Connection failed or timeout expired.
	87	(raise (condition
	88	(&message
69daee23	89	(message (format #f (G_ "SSH connection to '~a' failed: ~a~%")
615c5298 LC	90	host (get-error session))))))))))
615c5298 LC	91
e5378337 LC	92	(define* (remote-daemon-channel session
	93	#:optional
	94	(socket-name
	95	"/var/guix/daemon-socket/socket"))
	96	"Return an input/output port (an SSH channel) to the daemon at SESSION."
987a29ba LC	97	(define redirect
	98	;; Code run in SESSION to redirect the remote process' stdin/stdout to the
	99	;; daemon's socket, à la socat. The SSH protocol supports forwarding to
	100	;; Unix-domain sockets but libssh doesn't have an API for that, hence this
	101	;; hack.
	102	`(begin
	103	(use-modules (ice-9 match) (rnrs io ports))
	104
	105	(let ((sock (socket AF_UNIX SOCK_STREAM 0))
	106	(stdin (current-input-port))
	107	(stdout (current-output-port)))
	108	(setvbuf stdin _IONBF)
	109	(setvbuf stdout _IONBF)
	110	(connect sock AF_UNIX ,socket-name)
	111
	112	(let loop ()
	113	(match (select (list stdin sock) '() (list stdin stdout sock))
	114	((reads writes ())
	115	(when (memq stdin reads)
	116	(match (get-bytevector-some stdin)
	117	((? eof-object?)
	118	(primitive-exit 0))
	119	(bv
	120	(put-bytevector sock bv))))
	121	(when (memq sock reads)
	122	(match (get-bytevector-some sock)
	123	((? eof-object?)
	124	(primitive-exit 0))
	125	(bv
	126	(put-bytevector stdout bv))))
	127	(loop))
	128	(_
	129	(primitive-exit 1)))))))
	130
e5378337 LC	131	(open-remote-pipe* session OPEN_BOTH
	132	;; Sort-of shell-quote REDIRECT.
	133	"guile" "-c"
	134	(object->string
	135	(object->string redirect))))
	136
	137	(define* (connect-to-remote-daemon session
	138	#:optional
	139	(socket-name
	140	"/var/guix/daemon-socket/socket"))
	141	"Connect to the remote build daemon listening on SOCKET-NAME over SESSION,
	142	an SSH session. Return a <nix-server> object."
	143	(open-connection #:port (remote-daemon-channel session)))
	144
987a29ba LC	145
	146	(define (store-import-channel session)
	147	"Return an output port to which archives to be exported to SESSION's store
	148	can be written."
	149	;; Using the 'import-paths' RPC on a remote store would be slow because it
	150	;; makes a round trip every time 32 KiB have been transferred. This
	151	;; procedure instead opens a separate channel to use the remote
	152	;; 'import-paths' procedure, which consumes all the data in a single round
	153	;; trip.
	154	(define import
	155	`(begin
	156	(use-modules (guix))
	157
	158	(with-store store
	159	(setvbuf (current-input-port) _IONBF)
	160
	161	;; FIXME: Exceptions are silently swallowed. We should report them
	162	;; somehow.
	163	(import-paths store (current-input-port)))))
	164
	165	(open-remote-output-pipe session
	166	(string-join
	167	`("guile" "-c"
	168	,(object->string
	169	(object->string import))))))
	170
e9629e82 LC	171	(define* (store-export-channel session files
e9629e82 LC	172	#:key recursive?)
987a29ba	173	"Return an input port from which an export of FILES from SESSION's store can
e9629e82	174	be read. When RECURSIVE? is true, the closure of FILES is exported."
987a29ba LC	175	;; Same as above: this is more efficient than calling 'export-paths' on a
	176	;; remote store.
	177	(define export
	178	`(begin
	179	(use-modules (guix))
	180
	181	(with-store store
	182	(setvbuf (current-output-port) _IONBF)
	183
	184	;; FIXME: Exceptions are silently swallowed. We should report them
	185	;; somehow.
e9629e82 LC	186	(export-paths store ',files (current-output-port)
e9629e82 LC	187	#:recursive? ,recursive?))))
987a29ba LC	188
	189	(open-remote-input-pipe session
	190	(string-join
	191	`("guile" "-c"
	192	,(object->string
	193	(object->string export))))))
	194
	195	(define* (send-files local files remote
e9629e82 LC	196	#:key
	197	recursive?
	198	(log-port (current-error-port)))
987a29ba	199	"Send the subset of FILES from LOCAL (a local store) that's missing to
23973e4f LC	200	REMOTE, a remote store. When RECURSIVE? is true, send the closure of FILES.
23973e4f LC	201	Return the list of store items actually sent."
987a29ba	202	;; Compute the subset of FILES missing on SESSION and send them.
e9629e82 LC	203	(let* ((files (if recursive? (requisites local files) files))
e9629e82 LC	204	(session (channel-get-session (nix-server-socket remote)))
987a29ba LC	205	(node (make-node session))
	206	(missing (node-eval node
	207	`(begin
	208	(use-modules (guix)
	209	(srfi srfi-1) (srfi srfi-26))
	210
	211	(with-store store
	212	(remove (cut valid-path? store <>)
	213	',files)))))
	214	(count (length missing))
	215	(port (store-import-channel session)))
	216	(format log-port (N_ "sending ~a store item to '~a'...~%"
	217	"sending ~a store items to '~a'...~%" count)
	218	count (session-get session 'host))
	219
	220	;; Send MISSING in topological order.
	221	(export-paths local missing port)
	222
	223	;; Tell the remote process that we're done. (In theory the end-of-archive
	224	;; mark of 'export-paths' would be enough, but in practice it's not.)
	225	(channel-send-eof port)
	226
	227	;; Wait for completion of the remote process.
	228	(let ((result (zero? (channel-get-exit-status port))))
	229	(close-port port)
23973e4f	230	missing)))
987a29ba LC	231
	232	(define (remote-store-session remote)
	233	"Return the SSH channel beneath REMOTE, a remote store as returned by
	234	'connect-to-remote-daemon', or #f."
	235	(channel-get-session (nix-server-socket remote)))
	236
	237	(define (remote-store-host remote)
	238	"Return the name of the host REMOTE is connected to, where REMOTE is a
	239	remote store as returned by 'connect-to-remote-daemon'."
	240	(match (remote-store-session remote)
	241	(#f #f)
	242	((? session? session)
	243	(session-get session 'host))))
	244
e9629e82 LC	245	(define* (file-retrieval-port files remote
e9629e82 LC	246	#:key recursive?)
987a29ba LC	247	"Return an input port from which to retrieve FILES (a list of store items)
	248	from REMOTE, along with the number of items to retrieve (lower than or equal
	249	to the length of FILES.)"
e9629e82 LC	250	(values (store-export-channel (remote-store-session remote) files
	251	#:recursive? recursive?)
	252	(length files))) ;XXX: inaccurate when RECURSIVE? is true
987a29ba LC	253
987a29ba LC	254	(define* (retrieve-files local files remote
e9629e82	255	#:key recursive? (log-port (current-error-port)))
987a29ba	256	"Retrieve FILES from REMOTE and import them using the 'import-paths' RPC on
e9629e82	257	LOCAL. When RECURSIVE? is true, retrieve the closure of FILES."
987a29ba	258	(let-values (((port count)
e9629e82 LC	259	(file-retrieval-port files remote
e9629e82 LC	260	#:recursive? recursive?)))
987a29ba LC	261	(format #t (N_ "retrieving ~a store item from '~a'...~%"
	262	"retrieving ~a store items from '~a'...~%" count)
	263	count (remote-store-host remote))
13164a21 LC	264	(when (eof-object? (lookahead-u8 port))
	265	;; The failure could be because one of the requested store items is not
	266	;; valid on REMOTE, or because Guile or Guix is improperly installed.
	267	;; TODO: Improve error reporting.
	268	(raise (condition
	269	(&message
	270	(message
	271	(format #f
69daee23	272	(G_ "failed to retrieve store items from '~a'")
13164a21	273	(remote-store-host remote)))))))
987a29ba LC	274
	275	(let ((result (import-paths local port)))
	276	(close-port port)
	277	result)))
	278
	279	;;; ssh.scm ends here