Run commands on local or remote hosts using sh or ssh.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194
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))