Better host and localhost handling.
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
diff --git a/core/defs.lisp b/core/defs.lisp
index 422329d..f66ff2f 100644
--- a/core/defs.lisp
+++ b/core/defs.lisp
@@ -172,7 +172,6 @@
(defgeneric probe-hostname (host os))
(defgeneric probe-boot-time (host os))
-(defgeneric host-connect (host))
(defgeneric host-disconnect (host))
(defgeneric host-shell (host))
(defgeneric (setf host-shell) (shell host))
@@ -182,7 +181,6 @@
(define-resource-class ssh-host (host))
-(defvar *localhost*)
(defvar *host*)
;; Probing resources
@@ -191,7 +189,7 @@
((resource :initarg :resource)
(property :initarg :property)
(host :initarg :host
- :initform *host*)
+ :initform (current-host))
(os :initarg :os)))
(define-condition resource-probe-not-found (resource-probe-error)
diff --git a/core/host.lisp b/core/host.lisp
index 4ece086..e135770 100644
--- a/core/host.lisp
+++ b/core/host.lisp
@@ -18,16 +18,46 @@
(in-package :adams)
+(defun run (command &rest format-args)
+ (if (and (boundp '*host*)
+ (symbol-value '*host*))
+ (apply #'host-run *host* command format-args)
+ (with-shell (shell)
+ (apply #'shell-run shell command format-args))))
+
+;; localhost
+
+(assert (string= (machine-instance) (first (run "hostname"))))
+
+(defun local-hostname ()
+ (machine-instance))
+
+(defun localhost ()
+ (let ((id (local-hostname)))
+ (or #1=(get-resource 'host id)
+ (setf #1# (make-instance 'host :id id)))))
+
+(eval-when (:load-toplevel)
+ (setq *host* (localhost)))
+
+(defun host-connect (host)
+ (let ((id (resource-id host)))
+ (cond
+ ((string-equal (local-hostname) id)
+ (setf (host-shell host) (make-shell)))
+ (:otherwise
+ (setf (host-shell host) (make-shell "/usr/bin/ssh" id))))))
+
+(defun current-host ()
+ (or (when (boundp '*host*)
+ (symbol-value '*host*))
+ (localhost)))
+
;; Host
(defun hostname (host)
(resource-id (the host host)))
-#+nil
-(defmethod print-object ((host host) stream)
- (print-unreadable-object (host stream :type t :identity t)
- (write-string (hostname host) stream)))
-
;; Host shell
(defmethod host-shell ((host host))
@@ -46,8 +76,10 @@
(defun host (host)
(etypecase host
(host host)
- (string (if (string-equal (resource-id *localhost*) host)
- *localhost*
+ (string (if (or (string-equal (local-hostname) host)
+ (string-equal "localhost" host)
+ (string= "127.0.0.1" host))
+ (localhost)
(resource 'ssh-host host)))))
(defmethod host-run ((host host) (command string) &rest format-args)
@@ -66,34 +98,8 @@
(with-connected-host (host hostname)
(apply #'host-run host command format-args)))
-(defun run (command &rest format-args)
- (if (boundp '*host*)
- (apply #'host-run *host* command format-args)
- (with-shell (shell)
- (apply #'shell-run shell command format-args))))
-
-;; localhost
-
-(assert (string= (machine-instance) (first (run "hostname"))))
-
-(defvar *localhost*
- (load-time-value
- (let ((id (machine-instance)))
- (setf (get-resource 'host id)
- (make-instance 'host :id id)))))
-
-(defmethod host-connect ((host (eql *localhost*)))
- (setf (host-shell host) (make-shell)))
-
-;; SSH host
-
-(defmethod host-connect ((host ssh-host))
- (setf (host-shell host) (make-shell "/usr/bin/ssh" (hostname host))))
-
;; With host
-(defvar *host* *localhost*)
-
(defmacro with-host (host &body body)
`(let ((*host* (host ,host)))
(with-parent-resource *host*
diff --git a/core/probe.lisp b/core/probe.lisp
index c330c4e..e504461 100644
--- a/core/probe.lisp
+++ b/core/probe.lisp
@@ -75,12 +75,12 @@
(defmethod probe ((r resource) (property symbol))
(let* ((os (unless (and (typep r 'host)
(eq property :os))
- (host-os *host*)))
+ (host-os (current-host))))
(probe (or (find-probe r property os)
(error 'resource-probe-not-found
:resource r
:property property
- :host *host*
+ :host (current-host)
:os os)))
(result (funcall (probe-generic-function probe) r os)))
(when (eq +undefined+ (get-property property result))
@@ -88,7 +88,7 @@
:probe probe
:resource r
:property property
- :host *host*
+ :host (current-host)
:os os))
(add-probed-properties r result)
result))
@@ -110,7 +110,7 @@
(when p
(clear-probed r p))))
-(defun clear-probed (&optional (resource *localhost*) properties)
+(defun clear-probed (&optional (resource (localhost)) properties)
(clear-probed% resource properties))
;; Conditions
diff --git a/package.lisp b/package.lisp
index 58055c4..78b792b 100644
--- a/package.lisp
+++ b/package.lisp
@@ -102,14 +102,14 @@
#:resource-probe-failed
#:resource-diff
;; Host
- #:*host*
+ #:current-host
#:host
#:host-connect
#:host-disconnect
#:host-os
#:host-shell
#:host-run
- #:*localhost*
+ #:localhost
#:run
#:ssh-host
#:with-connected-host