Fix 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 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 195 196 197 198 199 200 201
diff --git a/core/defs.lisp b/core/defs.lisp
index f89991b..17836f5 100644
--- a/core/defs.lisp
+++ b/core/defs.lisp
@@ -102,6 +102,8 @@
:accessor probed-properties))
(:metaclass resource-class))
+(defgeneric resource-probes-properties (resource))
+
(setq *the-resource-class* (find-class 'resource))
;; Resource registry
@@ -146,6 +148,27 @@
:reader os-version
:type string)))
+;; Host
+
+(define-resource-class host (resource-tree)
+ ((shell :initarg :shell
+ :type shell))
+ ((probe-os-using-uname :properties (os))
+ (probe-hostname :properties (hostname))
+ (probe-uptime :properties (uptime))))
+
+(defgeneric host-connect (host))
+(defgeneric host-disconnect (host))
+(defgeneric host-shell (host))
+(defgeneric (setf host-shell) (shell host))
+
+(defgeneric host-run (host command &rest format-args))
+
+(define-resource-class ssh-host (host))
+
+(defvar *localhost*)
+(defvar *host*)
+
;; Probing resources
(define-condition resource-probe-error (error)
@@ -166,31 +189,3 @@
(defgeneric get-probed (resource property))
(defvar *resource*)
-
-;; BSD cksum
-
-(defvar *cksum-algorithms*
- '(cksum md4 md5 rmd160 sha1 sha224 sha256 sha384 sha512 sum sysvsum))
-
-;; Host
-
-(define-resource-class host (resource-tree)
- ((shell :initarg :shell
- :type shell))
- ((probe-os-using-uname :properties (os))
- (probe-hostname :properties (hostname))
- (probe-uptime :properties (uptime))))
-
-(defgeneric host-connect (host))
-(defgeneric host-disconnect (host))
-(defgeneric host-shell (host))
-(defgeneric (setf host-shell) (shell host))
-
-(defgeneric host-run (host command &rest format-args))
-
-(define-resource-class ssh-host (host)
- ()
- ())
-
-(defvar *localhost*)
-(defvar *host*)
diff --git a/core/host.lisp b/core/host.lisp
index 23f7df1..bf4b5bb 100644
--- a/core/host.lisp
+++ b/core/host.lisp
@@ -94,7 +94,7 @@
name release machine version))))
(defmethod host-os ((host host))
- (getf (probed-properties host) 'os))
+ (get-probed host 'os))
;; Host probes
diff --git a/core/resource.lisp b/core/resource.lisp
index 47ba8a6..a061fda 100644
--- a/core/resource.lisp
+++ b/core/resource.lisp
@@ -38,6 +38,24 @@
(defun resource-type (resource)
(class-name (class-of resource)))
+(defmethod resource-probes-properties ((res resource))
+ (let ((properties))
+ (dolist (probe (probes-of res))
+ (dolist (property (probe-properties probe))
+ (pushnew property properties)))
+ (sort properties #'string<)))
+
+#+nil
+(resource-probes-properties (resource 'file "/"))
+
+(defun probe-all-properties (res)
+ (dolist (p (resource-probes-properties res))
+ (get-probed res p))
+ (probed-properties res))
+
+#+nil
+(probe-all-properties (resource 'file "/"))
+
;; Resource tree
(defmethod print-object ((r resource-tree) stream)
diff --git a/package.lisp b/package.lisp
index b567acd..6ab296e 100644
--- a/package.lisp
+++ b/package.lisp
@@ -96,6 +96,7 @@
#:host
#:host-connect
#:host-disconnect
+ #:host-os
#:host-shell
#:host-run
#:*localhost*
diff --git a/unix/defs.lisp b/unix/defs.lisp
index f104b15..189ec7e 100644
--- a/unix/defs.lisp
+++ b/unix/defs.lisp
@@ -29,8 +29,14 @@
(define-resource-class vnode ()
()
((probe-vnode-using-ls :properties (mode links owner group size mtime))
- (probe-vnode-using-stat :properties (type permissions owner group size
- atime mtime ctime blocks))))
+ (probe-vnode-using-stat :properties (dev ino mode links uid gid rdev size
+ atime mtime ctime blksize blocks flags))))
+
+(defvar *cksum-legacy-algorithms*
+ '(cksum sum sysvsum))
+
+(defvar *cksum-algorithms*
+ `(md4 md5 rmd160 sha1 sha224 sha256 sha384 sha512 ,@*cksum-legacy-algorithms*))
(define-resource-class file (vnode)
()
diff --git a/unix/probes.lisp b/unix/probes.lisp
index 64e4406..2fab04c 100644
--- a/unix/probes.lisp
+++ b/unix/probes.lisp
@@ -100,14 +100,27 @@
#.(cons 'progn
(iter (for algorithm in *cksum-algorithms*)
+ (for legacy = (member algorithm *cksum-legacy-algorithms*))
(for name = (sym 'probe-file-cksum- algorithm))
(collect `(defgeneric ,name (file os)))
(collect `(defmethod ,name ((file file) (os os-unix))
(let ((id (resource-id file)))
- (iter (cksum<1> (algo name sum)
- in (run "cksum -a ~A ~A"
- ',algorithm
- (sh-quote id)))
- (when (and (string= ',algorithm algo)
- (string= id name))
+ (iter (,(if legacy 'cksum<1>-legacy 'cksum<1>)
+ ,(if legacy
+ '(sum size name)
+ '(algo name sum))
+ in (run ,(str "cksum -a " algorithm " ~A")
+ (sh-quote id)))
+ (when ,(if legacy
+ `(string= id name)
+ `(and (string= ',algorithm algo)
+ (string= id name)))
(return (list ',algorithm sum)))))))))
+
+(defgeneric probe-file-content (file os))
+
+(defvar *probe-file-content-size-limit* 8192)
+
+(defmethod probe-file-content ((file file) (os os-unix))
+ (when (< (get-probed file 'size) *probe-file-content-size-limit*)
+ (list 'content (run "cat ~A" (sh-quote (resource-id file))))))
diff --git a/unix/syntaxes.lisp b/unix/syntaxes.lisp
index d3c2a99..afb1492 100644
--- a/unix/syntaxes.lisp
+++ b/unix/syntaxes.lisp
@@ -77,6 +77,10 @@
(values file dev ino mode links uid gid rdev size
atime mtime ctime blksize blocks flags))
+(define-syntax cksum<1>-legacy (sum size file)
+ #~|(\S+) (\S+) (\S+)|
+ "Syntax for cksum(1) legacy output.")
+
(define-syntax cksum<1> (algo sum file)
#~|(\S+) \((.*)\) = (\S+)|
"Syntax for cksum(1) output.")