suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add support for specifying keys for ssh.

Browse Source 
This allows non-default private keys in the `remote-shell` library.
Also, allow the appropriate private key to be specified for a pkg-build.
This commit is contained in:
Sam Tobin-Hochstadt 2014-10-29 13:54:22 -04:00
parent edd50a24a8
commit 96c3808460
3 changed files with 19 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
pkgs/plt-services/meta/pkg-build/main.rkt
View File

@ -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))))

4
pkgs/remote-shell-pkgs/remote-shell-doc/remote-shell.scrbl
View File

@ -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.}

11
pkgs/remote-shell-pkgs/remote-shell-lib/ssh.rkt
View File

@ -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