You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
111 lines
2.1 KiB
111 lines
2.1 KiB
#lang racket
|
|
|
|
(require remote-shell/ssh)
|
|
(require "directory.rkt")
|
|
(require "shell_env.rkt")
|
|
|
|
(define (strip-first-line st)
|
|
(string-join
|
|
(cdr
|
|
(string-split st "\n"))
|
|
"\n"))
|
|
|
|
(define cwd
|
|
(make-parameter "~"))
|
|
|
|
(define host
|
|
(make-parameter #f))
|
|
|
|
(define hostname
|
|
(make-parameter #f))
|
|
|
|
(define user
|
|
(make-parameter #f))
|
|
|
|
(define commands
|
|
(make-parameter #f))
|
|
|
|
(define-syntax-rule
|
|
(plan expr ...)
|
|
(parameterize
|
|
([commands (list)])
|
|
(begin expr ...)))
|
|
|
|
(define-syntax-rule
|
|
(with-cwd dir expr ...)
|
|
(parameterize
|
|
([cwd
|
|
(match (substring dir 0 1)
|
|
["/" dir]
|
|
[_ (format "~a/~a" (cwd) dir)])])
|
|
(begin expr ...)))
|
|
|
|
(define-syntax-rule
|
|
(with-host remote expr ...)
|
|
(parameterize
|
|
([host remote]
|
|
[hostname (remote-host remote)])
|
|
(begin expr ...)))
|
|
|
|
(define-syntax-rule
|
|
(become username expr ...)
|
|
(parameterize
|
|
([user username])
|
|
(begin expr ...)))
|
|
|
|
(define (as-user cmd)
|
|
(if
|
|
(user)
|
|
(format "sudo -u ~a sh -c '~a'"
|
|
(user)
|
|
cmd)
|
|
cmd))
|
|
|
|
(define (exec cmd)
|
|
(displayln
|
|
(format "Executed on ~a:" (remote-host (host))))
|
|
(match
|
|
(ssh (host)
|
|
(as-user
|
|
(format "cd ~a && ~a ~a"
|
|
(cwd)
|
|
(format-vars)
|
|
cmd)
|
|
)
|
|
#:failure-log "/tmp/test.log"
|
|
#:mode 'output)
|
|
[(cons code output)
|
|
(cons code
|
|
(strip-first-line
|
|
(bytes->string/utf-8 output)))]
|
|
[output output]))
|
|
|
|
(define (copy-file source dest)
|
|
(displayln
|
|
(format "Copying file to ~a:" (remote-host (host))))
|
|
(scp
|
|
(host)
|
|
source
|
|
(format "~a@~a:~a" (user) (remote-host (host)) dest)
|
|
#:mode 'result))
|
|
|
|
(define (copy-dir source dest)
|
|
(define tar-path (compress source))
|
|
(copy-file tar-path tar-path)
|
|
(remove-tmp tar-path)
|
|
(exec (format "mkdir -p ~a" dest))
|
|
(exec (format "tar -xzvf ~a -C ~a" tar-path dest))
|
|
(exec (format "rm ~a" tar-path)))
|
|
|
|
(define ((make-cmd cmd)) (exec cmd))
|
|
|
|
(define ls (make-cmd "ls"))
|
|
(define pwd (make-cmd "pwd"))
|
|
|
|
(provide
|
|
(all-defined-out)
|
|
remote
|
|
compress
|
|
shell-env
|
|
format-vars
|
|
with-shell-vars)
|
|
|