Merge pull request #33 from takagi/issue/29

Introduce SSH and SCP functions for remote provisioning.

README.md

@@ -151,26 +151,71 @@ Loads a Lakefile specified with `pathname` to execute a task of name `target` de
 
     (lake :target "hello")
 
+### [Function] echo
+
+    ECHO string
+
+Writes the given `string` into the standard output followed by a new line, provided for UNIX terminology convenience.
+
+    (task "say-hello" ()
+      (echo "Hello world!"))
+
 ### [Function] sh
 
     SH command &key echo
 
-Spawns a subprocess that runs the specified `command` given as a string. When `echo` is `t`, prints `command` to the standard output before runs it. Actually it is a very thin wrapper of `uiop:run-program` provided for UNIX terminology convenience. 
+Spawns a subprocess that runs the specified `command` given as a string. When `echo` is not `nil`, prints `command` to the standard output before running it. Actually it is a very thin wrapper of `uiop:run-program` provided for UNIX terminology convenience.
 Acompanied with cl-interpol's `#?` reader macro, you get more analogous expressions to shell scripts.
 
     (defparameter cc "gcc")
 
     (task "hello" ("hello.c")
       (sh #?"${cc} -o hello hello.c"))
 
-### [Function] echo
+### [Function] ssh
 
-    ECHO string
+    SSH command &key echo
 
-Writes the given `string` into the standard output followed by a new line, provided for UNIX terminology convenience.
+Spawns a subprocess that runs the specified `command`, given as a string, on a remote host using `ssh(1)`. `*ssh-host*`, `*ssh-user*` and `*ssh-identity*` should be bound properly before use this. When `echo` is not `nil`, prints `ssh` command published to the standard output before running it.
 
-    (task "say-hello" ()
-      (echo "Hello world!"))
+    (setf *ssh-host* "remotehost")
+    (setf *ssh-user* "user")
+    (task "hello-via-ssh" ()
+      (ssh "echo Hello World!"))
+
+Note that the following binding does not work as intended because the dynamic binding only keep when `task` macro is evaluated, have already exited when `ssh` function is to be actually evaluated.
+
+    ;; Does not work as intended.
+    (let ((*ssh-host* "localhost")
+          (*ssh-user* "`whoami`"))
+      (task "hello-via-ssh" ()
+        (ssh "echo Hello World!")))
+
+Instead, the next works as intended. Anyway, the former style with `setf` would be enough in Lakefile.
+
+    ;; Works as intended.
+    (task "hello-via-ssh" ()
+      (let ((*ssh-host* "localhost")
+            (*ssh-user* "`whoami`"))
+        (ssh "echo Hello World!")))
+
+### [Special Variable] \*ssh-host\*, \*ssh-user\*, \*ssh-identity\*
+
+These special variables are used to establish a secure connection using `ssh` function. The default value of `*ssh-host*` is unbound so it should be always bound properly when using secure connections. The default value of `*ssh-user*` is `nil`, for giving optional user name. The default value of `*ssh-identity*` is `nil`, for giving optional identity file to prove his/her identity to the remote machine.
+
+### [Function] scp
+
+    SCP from-place pathspec1 to-place pathspec2 &key echo
+
+Copies files between hosts on a network using `scp(1)`. `from-place`, which must be `:local` or `:remote`, specifies if `pathspec1` is a file path on local host or remote host respectively. `pathspec1` is a file path to be copied from, given as a string or a pathname. `to-place` and `pathspec2` are same as `from-place` and `pathspec1` except that they are about files to be copied to.
+
+As `ssh` function above, `*ssh-host*`, `*ssh-user*` and `*ssh-identity*` should be bound properly before use this. When `echo` is not `nil`, prints `scp` command published to the standard output before running it.
+
+    (setf *ssh-host* "remotehost")
+    (setf *ssh-user* "user")
+    (task "scp" ()
+      "Copy ~/foo on local host to ~/foo on remote host."
+      (scp :local "~/foo" :remote "~/foo"))
 
 ### [Function] execute
 

src/lake.lisp

@@ -7,8 +7,13 @@
            :task
            :file
            :directory
-           :sh
            :echo
+           :sh
+           :*ssh-host*
+           :*ssh-user*
+           :*ssh-identity*
+           :ssh
+           :scp
            :execute)
   (:shadow :directory)
   (:import-from :alexandria
@@ -302,17 +307,69 @@
 
 
 ;;;
-;;; Run
+;;; Echo
 ;;;
 
 (defun echo (string)
   (write-line string))
 
+
+;;;
+;;; SH
+;;;
+
 (defun sh (command &key echo)
   (when echo
     (echo command))
   (run-program command :output t :error-output t))
 
+
+;;;
+;;; SSH
+;;;
+
+(defvar *ssh-host*)
+
+(defvar *ssh-user* nil)
+
+(defvar *ssh-identity* nil)
+
+(defparameter +ssh-control-string+
+  "ssh ~@[-i ~A ~]-o \"StrictHostKeyChecking no\" ~@[~A@~]~A ~S")
+
+(defun ssh (command &key echo)
+  (let ((command1 (format nil +ssh-control-string+
+                          *ssh-identity* *ssh-user* *ssh-host* command)))
+    (sh command1 :echo echo)))
+
+
+;;;
+;;; SCP
+;;;
+
+(defun scp-filepath (pathspec place)
+  (check-type pathspec (or pathname string))
+  (unless (member place '(:local :remote))
+    (error "The value ~S is not :local nor :remote." place))
+  (if (eq place :remote)
+      (format nil "~@[~A@~]~A:~A" *ssh-user* *ssh-host* pathspec)
+      (princ-to-string pathspec)))
+
+(defparameter +scp-control-string+
+  "scp ~@[-i ~A ~]-o \"StrictHostKeyChecking no\" ~A ~A")
+
+(defun scp (from-place pathspec1 to-place pathspec2 &key echo)
+  (let ((path1 (scp-filepath pathspec1 from-place))
+        (path2 (scp-filepath pathspec2 to-place)))
+    (let ((command (format nil +scp-control-string+
+                           *ssh-identity* path1 path2)))
+      (sh command :echo echo))))
+
+
+;;;
+;;; Execute
+;;;
+
 (defun execute (task-name)
   (%execute task-name *namespace*))
 

t/lake.lisp

@@ -535,13 +535,67 @@
 
 
 ;;;
-;;; Run
+;;; Echo
+;;;
+
+
+;;;
+;;; SH
 ;;;
 
 (subtest "sh"
   (is-print (sh "echo foo" :echo t)
             (format nil "echo foo~%foo~%")))
 
+
+;;;
+;;; SSH
+;;;
+
+(subtest "ssh"
+  (let ((*ssh-host* "localhost")
+        (*ssh-user* "`whoami`")
+        (*ssh-identity* nil))
+    (is-print (ssh "echo foo" :echo t)
+              (format nil "ssh -o \"StrictHostKeyChecking no\" `whoami`@localhost \"echo foo\"~%foo~%"))))
+
+
+;;;
+;;; SCP
+;;;
+
+(subtest "scp"
+
+  (let ((*ssh-host* "localhost")
+        (*ssh-user* "`whoami`")
+        (*ssh-identity* nil))
+    (with-test-directory
+      (sh "touch foo")
+      (scp :local #P"foo" :remote #P"lake/t/bar") ; Assuming on CircleCI.
+      (is-print (sh "ls foo bar")
+                (format nil "bar~%foo~%"))))
+
+  (is-error (scp :foo #P"foo" :remote #P"bar")
+            simple-error
+            "invalid scp place.")
+
+  (is-error (scp :local :foo :remote #P"bar")
+            type-error
+            "invalid pathspec.")
+
+  (is-error (scp :local #P"foo" :foo #P"bar")
+            simple-error
+            "invalid scp place.")
+
+  (is-error (scp :local #P"foo" :remote :foo)
+            type-error
+            "invalid pathspec."))
+
+
+;;;
+;;; Execute
+;;;
+
 (subtest "execute"
 
   (let ((lake::*tasks* nil))