Commit 792771713ed04e981de0f986c4a4111c2373ad58

Thomas de Grivel 2014-10-03T11:42:57

Run commands on local or remote hosts using sh or ssh.

diff --git a/adams.asd b/adams.asd
index 23ee44d..9ec18c9 100644
--- a/adams.asd
+++ b/adams.asd
@@ -26,7 +26,14 @@
   :author "Thomas de Grivel <billitch@gmail.com>"
   :version "0.1"
   :description "Remote system administration tools"
-  :depends-on ("alexandria" "cl-base64" "cl-ppcre" "closer-mop" "iterate")
+  :depends-on ("alexandria"
+	       "cl-base64"
+	       "cl-debug"
+	       "cl-ppcre"
+	       "closer-mop"
+	       "ironclad"
+	       "iterate"
+	       "trivial-utf-8")
   :components
   ((:file "package")
    (:module "shell" :depends-on ("package")
@@ -34,6 +41,7 @@
 	    ((:file "shell")
 	     #+sbcl
 	     (:file "sb-shell" :depends-on ("shell"))))
-   (:file "host" :depends-on ("shell"))
-   (:file "resource" :depends-on ("host"))
+   (:file "resource" :depends-on ("shell"))
+   (:file "manifest" :depends-on ("resource"))
+   (:file "host" :depends-on ("manifest"))
    (:file "unix" :depends-on ("resource"))))
diff --git a/host.lisp b/host.lisp
index 1297984..6d12b0f 100644
--- a/host.lisp
+++ b/host.lisp
@@ -21,18 +21,33 @@
 ;;  Host
 
 (defclass host ()
-  ((name :type string :initarg :hostname :reader hostname)
-   (shell :type shell :accessor host-shell)))
-
-(defgeneric host-connect (host))
-(defgeneric host-disconnect (host))
+  ((name :type string
+	 :initarg :hostname
+	 :reader hostname)
+   (shell :type shell
+	  :initarg :shell)
+   (manifest :type manifest
+	     :initarg :manifest
+	     :reader host-manifest)))
 
 (defmethod print-object ((host host) stream)
   (print-unreadable-object (host stream :type t :identity t)
     (write-string (hostname host) stream)))
 
-(defmethod slot-unbound (class (host host) (slot (eql 'shell)))
-  (host-connect host))
+;;  Host shell
+
+(defgeneric host-connect (host))
+(defgeneric host-disconnect (host))
+(defgeneric host-shell (host))
+(defgeneric (setf host-shell) (shell host))
+
+(defmethod host-shell ((host host))
+  (if (slot-boundp host 'shell)
+      (slot-value host 'shell)
+      (setf (slot-value host 'shell) (host-connect host))))
+
+(defmethod (setf host-shell) ((shell shell) (host host))
+  (setf (slot-value host 'shell) shell))
 
 (defmethod host-disconnect ((host host))
   (when (slot-boundp host 'shell)
@@ -46,14 +61,24 @@
 	 (host-disconnect ,g!host)))))
 
 (defun host-run (host command &rest format-args)
-  (apply #'shell-run (host-shell host) command format-args))
+  (let ((shell (host-shell host)))
+    (when (shell-closed-p shell)
+      (setq shell (host-connect host)))
+    (apply #'shell-run shell command format-args)))
+
+;;  Host manifest
+
+(defmethod slot-unbound (class (host host) (slot-name (eql 'manifest)))
+  (setf (slot-value host 'manifest) (manifest (hostname host))))
 
 ;;  localhost
 
 (defvar *localhost* (load-time-value
-		     (make-instance 'host :hostname "localhost")))
+		     (make-instance 'host
+				    :hostname "localhost")))
 
 (defmethod host-connect ((host (eql *localhost*)))
+  (assert (null (host-shell host)))
   (setf (host-shell host) (make-shell)))
 
 ;;  SSH host
@@ -61,7 +86,8 @@
 (defclass ssh-host (host) ())
 
 (defmethod host-connect ((host ssh-host))
-  (setf (host-shell host) (make-shell `("/usr/bin/ssh" ,(hostname host)))))
+  (assert (null (host-shell host)))
+  (setf (host-shell host) (make-shell "/usr/bin/ssh" (hostname host))))
 
 ;;  High level API
 
@@ -69,7 +95,8 @@
 
 (defmacro with-host (hostname &body body)
   `(with-connected-host (*host* ,hostname)
-     ,@body))
+     (let ((*manifest* (host-manifest *host*)))
+       ,@body)))
 
 (defun run (command &rest format-args)
   (apply #'host-run *host* command format-args))
diff --git a/package.lisp b/package.lisp
index 7543a85..71f0127 100644
--- a/package.lisp
+++ b/package.lisp
@@ -19,9 +19,8 @@
 (in-package :cl-user)
 
 (defpackage :adams
-  (:use :alexandria :cl :iterate)
+  (:use :alexandria :cl :debug :iterate)
   (:export
-   #:*debug*
    ;;  Shell
    #:*default-shell-command*
    #:*shell-signal-errors*
@@ -54,6 +53,13 @@
    #:define-resource-class
    #:resource
    #:gather-resource
+   ;;  Manifest
+   #:manifest
+   #:manifest-resources
+   #:find-manifest
+   #:remove-manifest
+   #:with-manifest
+   #:define-resource
    ;;  Unix
    #:+timestamp-offset+
    #:timestamp-to-universal-time
@@ -73,4 +79,4 @@
    #:stat<1>))
 
 (defpackage :adams-user
-  (:use :cl :adams))
+  (:use :adams :cl :cl-debug))
diff --git a/shell/sb-shell.lisp b/shell/sb-shell.lisp
index b834925..5a6e19d 100644
--- a/shell/sb-shell.lisp
+++ b/shell/sb-shell.lisp
@@ -31,6 +31,9 @@
   (sb-ext:process-kill (shell-process shell) sb-unix:sigterm)
   (sb-ext:process-close (shell-process shell)))
 
+(defmethod shell-closed-p ((shell sb-shell))
+  (not (eq :running (sb-ext:process-status (shell-process shell)))))
+
 (defmethod shell-pid ((shell sb-shell))
   (sb-ext:process-pid (shell-process shell)))
 
@@ -63,8 +66,8 @@
   (write-string data (sb-ext:process-input (shell-process shell))))
 
 (defmethod shell-out/line ((shell sb-shell))
-  (let ((out (read-line (sb-ext:process-output (shell-process shell)))))
-    (when (find 'sb-shell *debug*)
+  (let ((out (read-line (sb-ext:process-output (shell-process shell)) nil nil)))
+    (when (and out (debug-p :sb-shell))
       (format *debug-io* "~A~%" out)
       (force-output *debug-io*))
     out))
diff --git a/shell/shell.lisp b/shell/shell.lisp
index 91e97eb..140c0c7 100644
--- a/shell/shell.lisp
+++ b/shell/shell.lisp
@@ -104,6 +104,7 @@ Error: ~S"
 (defgeneric shell-err (shell))
 (defgeneric shell-status (shell))
 (defgeneric shell-close (shell))
+(defgeneric shell-closed-p (shell))
 
 (defmethod shell-status ((shell shell))
   (let* ((delim (make-delimiter))