diff --git a/pkgs/plt-services/meta/pkg-build/main.rkt b/pkgs/plt-services/meta/pkg-build/main.rkt index f58cc5c5c4..b1437badc9 100644 --- a/pkgs/plt-services/meta/pkg-build/main.rkt +++ b/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)))) diff --git a/pkgs/remote-shell-pkgs/remote-shell-doc/remote-shell.scrbl b/pkgs/remote-shell-pkgs/remote-shell-doc/remote-shell.scrbl index e174d64e64..13bb0d6f3c 100644 --- a/pkgs/remote-shell-pkgs/remote-shell-doc/remote-shell.scrbl +++ b/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.} diff --git a/pkgs/remote-shell-pkgs/remote-shell-lib/ssh.rkt b/pkgs/remote-shell-pkgs/remote-shell-lib/ssh.rkt index 323c17a58f..b6e832ca3a 100644 --- a/pkgs/remote-shell-pkgs/remote-shell-lib/ssh.rkt +++ b/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