diff --git a/bolt.rkt b/bolt.rkt index 4df28b7..5bb517e 100755 --- a/bolt.rkt +++ b/bolt.rkt @@ -1,6 +1,7 @@ #lang racket (require remote-shell/ssh) +(require "directory.rkt") (define (strip-first-line st) (string-join @@ -86,8 +87,13 @@ (format "~a@~a:~a" (user) (remote-host (host)) dest) #:mode 'result)) - -; TODO copy directories by gzipping them up somehow +(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)) @@ -95,4 +101,4 @@ (define pwd (make-cmd "pwd")) (provide - (all-defined-out) remote) + (all-defined-out) remote compress) diff --git a/directory.rkt b/directory.rkt new file mode 100644 index 0000000..83e22e3 --- /dev/null +++ b/directory.rkt @@ -0,0 +1,33 @@ +#lang racket + +(require racket/system) + +(define (clean-path path) + (string-replace path "/" "_")) + +(define (compress directory) + (define tar + (find-executable-path "tar")) + + (define path + (format "/tmp/~a.tar.gz" + (clean-path directory))) + + (system* tar "-zcvf" path directory) + path) + +(define (remove-tmp path) + (define rm + (find-executable-path "rm")) + (system* rm path)) + +(define (drop-last-dir path) + (define ps (explode-path path)) + (define paths (take ps (sub1 (length ps)))) + (path->string + (apply build-path paths))) + +(provide + drop-last-dir + compress + remove-tmp)