Merge branch 'master' of github.com:nisstyre56/Bolt

README.md

@@ -9,7 +9,7 @@ for basic tasks.
 ### Installation
 ```
 git clone git@github.com:weskerfoot/Bolt.git
-cd bolt; raco pkg install
+raco pkg install ./bolt
 ```
 
 Example:

bolt/bolt.rkt

@@ -1,111 +1,6 @@
 #lang racket
 
-(require remote-shell/ssh)
+(require "library.rkt")
-(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 (shell-env))
-                 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)
+  (all-from-out "library.rkt"))
-  remote
-  compress
-  shell-env
-  format-vars
-  with-shell-vars)

bolt/execute.rkt

@@ -0,0 +1,54 @@
+#! /usr/bin/env racket
+#lang racket
+
+(define (read-avail from-port callback)
+  (define ready
+    (sync
+      (read-bytes-evt 1 from-port)))
+
+  (if (not (eof-object? ready))
+      (begin
+        (callback ready)
+        (read-avail from-port callback))
+      (callback #f)))
+
+
+(define (execute-async to-port)
+  (define command (thread-receive))
+
+  (displayln command to-port)
+
+  (flush-output to-port)
+  (execute-async to-port))
+
+;; you tell it the remote, and pass it a callback
+;; the callback gets hooked into another thread that waits for output
+;; the callback executes on any output
+;; the output might be parsed into a standard format
+
+(define (make-executor host callback)
+
+  (match-define (list from-remote
+                      to-remote
+                      pid
+                      error-from-remote
+                      control-remote)
+    (process (format "ssh -tt ~a" host)))
+
+  (thread
+    (lambda () (read-avail from-remote callback)))
+
+  (define
+    executor
+    (thread (lambda () (execute-async to-remote))))
+
+  (lambda (command)
+    (thread-send executor command)))
+
+(define (make-exec hostname)
+  (make-executor
+    hostname
+    (lambda (result)
+      (display result))))
+
+(provide make-exec)

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

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