Commit cfb522afb0777228c1cc0d47bce37dff8a1e2a81
2015-08-01T01:39:43
Probe to resources whenever possible and add functions to match probed values.
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
diff --git a/core/properties.lisp b/core/properties.lisp
index 41bedf7..2be489f 100644
--- a/core/properties.lisp
+++ b/core/properties.lisp
@@ -50,6 +50,11 @@
(defmethod compare-property-values (resource property value1 value2)
(equalp value1 value2))
+(defmethod compare-property-values (resource property
+ (value1 local-time:timestamp)
+ (value2 local-time:timestamp))
+ (local-time:timestamp= value1 value2))
+
(defmethod merge-property-values (resource property old new)
(unless (compare-property-values resource property old new)
(warn "Conflicting values for property ~A in
diff --git a/core/resource.lisp b/core/resource.lisp
index e155faf..cd52de3 100644
--- a/core/resource.lisp
+++ b/core/resource.lisp
@@ -90,6 +90,18 @@
value)
value)
+(defmethod describe-probed-property-value ((resource t)
+ (property t)
+ (value resource))
+ (resource-id value))
+
+(defmethod describe-probed-property-value ((resource t)
+ (property t)
+ (value list))
+ (if (every #'resource-p value)
+ (mapcar #'resource-id value)
+ value))
+
(defmethod describe-probed% ((res resource) (out (eql :form)))
(let* ((props (probe-all-properties res))
(sorted-keys (sort (iter (for* (k v) in props)
diff --git a/unix/probes.lisp b/unix/probes.lisp
index cb3f85d..0440fbc 100644
--- a/unix/probes.lisp
+++ b/unix/probes.lisp
@@ -41,8 +41,10 @@
(string (egrep (str #\^ id #\:) "/etc/passwd"))))
(when (etypecase id
(string (string= id login))
- (integer (= id uid))))
- (return (values* #1#)))
+ (integer (= id uid)))
+ (setq home (resource 'directory home)
+ shell (resource 'file shell))
+ (return (values* #1#))))
(properties* #1#))))
(defmethod probe-user-groups-in-/etc/group ((user user) (os os-unix))
@@ -55,10 +57,10 @@
(groups (iter (group<5> (name passwd gid members)
in (grep user-login "/etc/group"))
(cond ((= user-gid gid)
- (setq user-group name))
+ (setq user-group (resource 'group name)))
((find user-login members :test #'string=)
- (collect name)))))
- (groups (sort groups #'string<))
+ (collect (resource 'group name))))))
+ (groups (sort groups #'string< :key #'resource-id))
(groups (if user-group
(cons user-group groups)
groups)))
@@ -72,6 +74,9 @@
(iter (ls<1>-lT #.(cons 'name '#1#)
in (ls "-ldT" id))
(when (string= id name)
+ (setq mode (mode (mode-permissions mode))
+ owner (resource 'user owner)
+ group (resource 'group group))
(return (values* #1#))))
(properties* #1#))))
@@ -82,7 +87,7 @@
(iter (stat<1>-r #.(cons 'name '#1#)
in (stat "-r" id))
(when (string= id name)
- (setq mode (mode-string mode))
+ (setq mode (mode (mode-permissions mode)))
(return (values* #1#))))
(properties* #1#))))