Browse Source

Reorganize things a bit

master
Wesley Kerfoot 5 years ago
parent
commit
1c60f3acda
  1. 112
      bolt/bolt.rkt
  2. 67
      bolt/library.rkt
  3. 54
      bolt/parameters.rkt

112
bolt/bolt.rkt

@ -1,114 +1,6 @@
#lang racket
(require "execute.rkt")
(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 executor
(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)]
[executor (make-exec (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
((executor)
(as-user
(format "cd ~a && ~a ~a"
(cwd)
(format-vars (shell-env))
cmd)
))
[(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"))
(require "library.rkt")
(provide
(all-defined-out)
remote
compress
shell-env
format-vars
with-shell-vars)
(all-from-out "library.rkt"))

67
bolt/library.rkt

@ -0,0 +1,67 @@
#lang racket
(require remote-shell/ssh)
(require "directory.rkt")
(require "shell_env.rkt")
(require "parameters.rkt")
;; Helper function
(define (strip-first-line st)
(string-join
(cdr
(string-split st "\n"))
"\n"))
(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
((executor)
(as-user
(format "cd ~a && ~a ~a"
(cwd)
(format-vars (shell-env))
cmd)
))
[(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-from-out remote-shell/ssh)
(all-from-out "parameters.rkt")
(all-from-out "directory.rkt")
(all-from-out "shell_env.rkt")
(all-defined-out))

54
bolt/parameters.rkt

@ -0,0 +1,54 @@
#lang racket
(require remote-shell/ssh)
(require "execute.rkt")
(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 executor
(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)]
[executor (make-exec (remote-host remote))])
(begin expr ...)))
(define-syntax-rule
(become username expr ...)
(parameterize
([user username])
(begin expr ...)))
(provide
(all-defined-out))
Loading…
Cancel
Save