Add support for specifying keys for ssh.

This allows non-default private keys in the `remote-shell` library.
Also, allow the appropriate private key to be specified for a pkg-build.

pkgs/plt-services/meta/pkg-build/main.rkt

@@ -58,7 +58,7 @@
 ;;  - tier-based selection of packages on conflict
 ;;  - support for running tests
 
-(struct vm (name host user dir env init-snapshot installed-snapshot minimal-variant))
+(struct vm (name host user dir env init-snapshot installed-snapshot minimal-variant ssh-key))
 
 ;; Each VM must provide at least an ssh server and `tar`, and the
 ;; intent is that it is otherwise isolated (e.g., no network
@@ -81,10 +81,13 @@
          #:installed-shapshot [installed-snapshot "installed"]
          ;; If not #f, a `vm` that is more constrained and will be
          ;; tried as an installation target before this one:
-         #:minimal-variant [minimal-variant #f])
+         #:minimal-variant [minimal-variant #f]
+         ;; Path to ssh key to use to connect to this VM:
+         ;; #f indicates that ssh's defaults are used
+         #:ssh-key [ssh-key #f])
   (unless (complete-path? dir)
     (error 'vbox-vm "need a complete path for #:dir"))
-  (vm name host user dir env init-snapshot installed-snapshot minimal-variant))
+  (vm name host user dir env init-snapshot installed-snapshot minimal-variant ssh-key))
 
 ;; The build steps:
 (define all-steps-in-order
@@ -295,6 +298,7 @@
                    (vm-env vm)
                    (list (cons "PLTUSERHOME"
                                (~a (vm-dir vm) "/user"))))
+            #:key (vm-ssh-key vm)
             #:timeout timeout
             #:remote-tunnels (list (cons server-port server-port))))
 

pkgs/remote-shell-pkgs/remote-shell-doc/remote-shell.scrbl

@@ -29,6 +29,7 @@ produced by @racket[remote], @racket[#f] otherwise.}
                  [#:remote-tunnels remote-tunnels (listof (cons/c (integer-in 1 65535)
                                                                   (integer-in 1 65535)))
                                    null]
+                 [#:key key (or/c #f path-string?)]
                  [#:timeout timeout-secs real? 600])
          remote?]{
 
@@ -44,6 +45,9 @@ the remote host back to the local host. The first port number in each
 pair is the port number on the remote host, and the second port number
 is the port that it tunnels to on the local host.
 
+If @racket[key] is not @racket[#f], then it is used as the path to an identity
+file used for public-key authentication.
+
 The @racket[timeout] argument specifies a timeout after which a remote
 command will be considered failed.}
 

pkgs/remote-shell-pkgs/remote-shell-lib/ssh.rkt

@@ -10,6 +10,7 @@
           (rename create-remote remote
                   ((#:host string?)
                    (#:user string?
+                           #:key (or/c #f path-string?)
                            #:env (listof (cons/c string? string?))
                            #:timeout real?
                            #:remote-tunnels (listof (cons/c (integer-in 1 65535)
@@ -32,17 +33,18 @@
                                       void?)]
           [at-remote (remote? path-string? . -> . string?)]))
 
-(struct remote (host user timeout remote-tunnels env)
+(struct remote (host user timeout remote-tunnels env key)
   #:constructor-name make-remote)
 
 (define create-remote
   (let ()
     (define (remote #:host host
                     #:user [user ""]
+                    #:key [key #f]
                     #:timeout [timeout 600]
                     #:remote-tunnels [remote-tunnels null]
                     #:env [env null])
-      (make-remote host user timeout remote-tunnels env))
+      (make-remote host user timeout remote-tunnels env key))
     remote))
 
 (define scp-exe (find-executable-path "scp"))
@@ -97,6 +99,7 @@
   (define timeout? #f)
   (define orig-thread (current-thread))
   (define timeout (remote-timeout remote))
+  (define key (remote-key remote))
   (define timeout-thread
     (thread (lambda ()
               (sleep timeout)
@@ -131,6 +134,7 @@
                       (for/list ([tunnel (in-list (remote-remote-tunnels remote))])
                         (list "-R" (~a (car tunnel) ":localhost:" (cdr tunnel)))))
                      (list (remote-user+host remote))
+                     (if key (list "-i" key) null)
                      ;; ssh needs an extra level of quoting
                      ;;  relative to sh:
                      (for/list ([arg (in-list cmd)])
@@ -155,7 +159,8 @@
        (error 'ssh "failed"))]))
 
 (define (scp remote src dest #:mode [mode 'error])
-  (define ok? (system*/show scp-exe src dest))
+  (define key (remote-key remote))
+  (define ok? (apply system*/show scp-exe (append (if key (list "-i" key) null) (list src dest))))
   (case mode
     [(result) ok?]
     [else