Commit b05f4cf3089997e9037f2599b411d2b5feffcb75

Thomas de Grivel 2015-07-23T18:32:30

Better host and localhost handling.

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