Commit 501913c0f5ec1416a50ae186bacb882435e14ab9
2015-09-20T23:09:30
Improve host probes.
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
diff --git a/core/defs.lisp b/core/defs.lisp
index 6a8316a..b33c73e 100644
--- a/core/defs.lisp
+++ b/core/defs.lisp
@@ -181,7 +181,8 @@
:type shell))
((probe-os-using-uname :properties (:os))
(probe-hostname :properties (:hostname))
- (probe-boot-time :properties (:boot-time))))
+ (probe-boot-time :properties (:boot-time))
+ (probe-host-user :properties (:user))))
(defgeneric probe-os-using-uname (host os))
(defgeneric probe-hostname (host os))
diff --git a/core/host.lisp b/core/host.lisp
index 2dbbcb1..e3081be 100644
--- a/core/host.lisp
+++ b/core/host.lisp
@@ -118,6 +118,10 @@
;; Host probes
+(defmethod describe-probed% ((host host) (out (eql :form)))
+ (with-host host
+ (call-next-method)))
+
(defmethod probe-os-using-uname ((host host) (os t))
(multiple-value-bind (name hostname release version machine) (uname)
(declare (ignore hostname))
@@ -148,3 +152,6 @@
(iter (uptime<1> (time uptime users load1 load5 load15) in (run "uptime"))
(return (list :boot-time (chronicity:parse
(str uptime " seconds ago"))))))
+
+(defmethod probe-host-user ((host host) (os os-unix))
+ (list :user (first (run "whoami"))))
diff --git a/core/os.lisp b/core/os.lisp
index aeb9aa5..3ac359f 100644
--- a/core/os.lisp
+++ b/core/os.lisp
@@ -22,14 +22,17 @@
(print-unreadable-object (os stream :type t :identity (not *print-pretty*))
(with-slots (machine name release version) os
(format stream "~A ~A ~A ~A"
- name release version machine))))
+ machine name release version))))
(defmethod describe-probed-property-value ((resource host)
(property (eql :os))
(os os))
(with-slots (machine name release version) os
(format nil "~A ~A ~A ~A"
- name release version machine)))
+ machine name release version)))
+
+(defmethod match-specified-value ((host host) (property (eql :os)) specified probed)
+ (re-match `(:sequence ,specified) probed))
;; UNIX
diff --git a/core/spec.lisp b/core/spec.lisp
index 484cab8..18cf9ce 100644
--- a/core/spec.lisp
+++ b/core/spec.lisp
@@ -128,6 +128,10 @@ Second value lists properties in line with spec. Format is
(when d
(collect (cons r d))))))
+(defmethod resource-diff ((host host))
+ (with-host host
+ (call-next-method)))
+
(defun resource-diff-to-plist (diff)
(iter (for item in diff)
(for key = (first item))
diff --git a/unix/commands.lisp b/unix/commands.lisp
index c01925b..05dd0c6 100644
--- a/unix/commands.lisp
+++ b/unix/commands.lisp
@@ -21,10 +21,9 @@
(in-re-readtable)
(defun uname ()
- (let ((uname-a (first (run "uname -a"))))
- (flet ((try-re (re)
- (re-bind re (os-name node-name os-release os-version machine) uname-a)))
- (try-re #~"^(\S+) (\S+) (\S+) (.+) (\S+)$"))))
+ (re-bind #~"^(\S+) (\S+) (\S+) (.+) (\S+)$"
+ (os-name node-name os-release os-version machine)
+ (first (run "uname -a"))))
(defun grep_ (pattern &rest files)
(join-str " " "grep" (sh-quote pattern) (mapcar #'sh-quote files)))