cl-adams/adams

diff --git a/adams.asd b/adams.asd
index fadb81b..e622b9c 100644
--- a/adams.asd
+++ b/adams.asd
@@ -34,6 +34,7 @@
 	       "closer-mop"
 	       "ironclad"
 	       "iterate"
+               "parse-number"
 	       "re"
 	       "str"
 	       "trivial-utf-8")
@@ -47,11 +48,15 @@
    (:module "core" :depends-on ("package" "shell")
 	    :components
 	    ((:file "defs")
-	     (:file "host"     :depends-on ("defs" "os"))
+	     (:file "host"       :depends-on ("defs" "os" "resource-container"
+                                              "syntaxes"))
 	     (:file "os")
-	     (:file "probe"    :depends-on ("defs" "host"))
-	     (:file "resource" :depends-on ("defs" "probe"))
-	     (:file "spec"     :depends-on ("defs" "resource"))))
+	     (:file "probe"      :depends-on ("defs" "host" "properties"))
+	     (:file "properties" :depends-on ("defs"))
+	     (:file "resource"   :depends-on ("defs" "probe"))
+	     (:file "resource-container" :depends-on ("defs"))
+	     (:file "spec"       :depends-on ("defs" "resource"))
+             (:file "syntaxes")))
    (:module "unix" :depends-on ("package" "shell" "core")
 	    :components
 	    ((:file "commands")
diff --git a/core/defs.lisp b/core/defs.lisp
index 17dce3d..422329d 100644
--- a/core/defs.lisp
+++ b/core/defs.lisp
@@ -18,8 +18,12 @@
 
 (in-package :adams)
 
+;;  Misc
+
 (unless (boundp '+undefined+)
-  (defconstant +undefined+ '#:undefined))
+  (defconstant +undefined+ '+undefined+))
+
+(defmethod subclasses (class))
 
 ;;  Probe
 
@@ -106,23 +110,30 @@
 
 (setq *the-resource-class* (find-class 'resource))
 
-;;  Resource registry
+;;  Resource container
 
-(defun make-*resources* ()
+(defun make-resource-registry ()
   (make-hash-table :test 'equalp))
 
-(defvar *resources*
-  (make-*resources*))
-
-;;  Resource tree class
-
-(defclass resource-tree (resource)
+(defclass resource-container (resource)
   ((resources :initarg :resources
-	      :initform (make-*resources*)
+	      :initform (make-resource-registry)
 	      :type hashtable
-	      :reader resources-of))
+	      :reader resource-registry))
   (:metaclass resource-class))
 
+(defvar *adams*
+  (make-instance 'resource-container :id "Adams"))
+
+(defvar *parent-resource*
+  *adams*)
+
+(defgeneric clear-resources% (resource-container))
+
+(defmacro with-parent-resource (resource &body body)
+  `(let ((*parent-resource* ,(or resource '*adams*)))
+     ,@body))
+
 ;;  Specifying resources
 
 (defgeneric specified-property (resource property))
@@ -150,18 +161,23 @@
 
 ;;  Host
 
-(define-resource-class host (resource-tree)
+(define-resource-class host (resource-container)
   ((shell :initarg :shell
 	  :type shell))
   ((probe-os-using-uname :properties (:os))
    (probe-hostname :properties (:hostname))
-   (probe-uptime :properties (:uptime))))
+   (probe-boot-time :properties (:boot-time))))
+
+(defgeneric probe-os-using-uname (host os))
+(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))
 
+(defgeneric host-os (host))
 (defgeneric host-run (host command &rest format-args))
 
 (define-resource-class ssh-host (host))
@@ -187,5 +203,24 @@
 (defgeneric find-probe (resource property os))
 (defgeneric probe (resource property))
 (defgeneric get-probed (resource property))
+(defgeneric clear-probed% (resource properties))
+(defgeneric describe-probed% (resource output))
 
 (defvar *resource*)
+
+;;  Operators on property lists
+
+(defmacro remf* (place indicator)
+  `(iter (while (remf ,place ,indicator))
+         (counting t)))
+
+(iterate:defmacro-clause (for* vars in list)
+  (let ((l (gensym "LIST-")))
+    `(progn
+       (with ,l = ,list)
+       (while ,l)
+       ,@(iter (for var in vars)
+               (collect `(for ,var = (if ,l
+                                         (pop ,l)
+                                         (error "~S is not congruent to ~S"
+                                                ',list ',vars))))))))
diff --git a/core/host.lisp b/core/host.lisp
index 2836da5..4ece086 100644
--- a/core/host.lisp
+++ b/core/host.lisp
@@ -43,11 +43,12 @@
     (shell-close (host-shell host))
     (slot-makunbound host 'shell)))
 
-(defmacro with-connected-host ((var hostname) &body body)
-  (let ((g!host (gensym "HOST-")))
-    `(let ((,g!host (make-instance 'ssh-host :id ,hostname)))
-       (unwind-protect (let ((,var ,g!host)) ,@body)
-	 (host-disconnect ,g!host)))))
+(defun host (host)
+  (etypecase host
+    (host host)
+    (string (if (string-equal (resource-id *localhost*) host)
+                *localhost*
+                (resource 'ssh-host host)))))
 
 (defmethod host-run ((host host) (command string) &rest format-args)
   (let ((shell (host-shell host)))
@@ -55,15 +56,31 @@
       (setq shell (host-connect host)))
     (apply #'shell-run shell command format-args)))
 
+(defmacro with-connected-host ((var hostname) &body body)
+  (let ((g!host (gensym "HOST-")))
+    `(let ((,g!host (make-instance 'ssh-host :id ,hostname)))
+       (unwind-protect (let ((,var ,g!host)) ,@body)
+         (host-disconnect ,g!host)))))
+
 (defmethod host-run ((hostname string) command &rest format-args)
   (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
 
-(defvar *localhost* (load-time-value
-		     (make-instance 'host
-				    :id "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)))
@@ -73,18 +90,15 @@
 (defmethod host-connect ((host ssh-host))
   (setf (host-shell host) (make-shell "/usr/bin/ssh" (hostname host))))
 
-;;  High level API
+;;  With host
 
 (defvar *host* *localhost*)
 
-(defmacro with-host (hostname &body body)
-  `(with-connected-host (*host* ,hostname)
-     (let ((*manifest* (host-manifest *host*)))
+(defmacro with-host (host &body body)
+  `(let ((*host* (host ,host)))
+     (with-parent-resource *host*
        ,@body)))
 
-(defun run (command &rest format-args)
-  (apply #'host-run *host* command format-args))
-
 ;;  OS
 
 (defmethod print-object ((os os) stream)
@@ -94,7 +108,7 @@
 	    name release machine version))))
 
 (defmethod host-os ((host host))
-  (get-probed host 'os))
+  (get-probed host :os))
 
 ;;  Host probes
 
@@ -123,3 +137,8 @@
 
 (defmethod probe-hostname ((host host) (os os-unix))
   (cons :hostname (run "hostname")))
+
+(defmethod probe-boot-time ((host host) (os os-unix))
+  (iter (uptime<1> (time uptime users load1 load5 load15) in (run "uptime"))
+        (return (list :boot-time (chronicity:parse
+                                  (str uptime " seconds ago"))))))
diff --git a/core/probe.lisp b/core/probe.lisp
index bb40881..c330c4e 100644
--- a/core/probe.lisp
+++ b/core/probe.lisp
@@ -68,8 +68,14 @@
 		  probe))))
 	  (probes-of r)))
 
+(defun add-probed-properties (resource properties)
+  (setf (probed-properties resource)
+        (merge-properties properties (probed-properties resource))))
+
 (defmethod probe ((r resource) (property symbol))
-  (let* ((os (host-os *host*))
+  (let* ((os (unless (and (typep r 'host)
+                          (eq property :os))
+               (host-os *host*)))
 	 (probe (or (find-probe r property os)
 		    (error 'resource-probe-not-found
 			   :resource r
@@ -77,23 +83,36 @@
 			   :host *host*
 			   :os os)))
 	 (result (funcall (probe-generic-function probe) r os)))
-    (when (eq +undefined+ (getf result property +undefined+))
+    (when (eq +undefined+ (get-property property result))
       (error 'resource-probe-failed
 	     :probe probe
 	     :resource r
 	     :property property
 	     :host *host*
 	     :os os))
-    (setf (probed-properties r)
-	  (append result (probed-properties r)))
+    (add-probed-properties r result)
     result))
 
 (defmethod get-probed ((r resource) (property symbol))
-  (let ((value (getf (probed-properties r) property +undefined+)))
+  (let ((value (get-property property (probed-properties r))))
     (when (eq +undefined+ value)
-      (setq value (getf (probe r property) property +undefined+)))
+      (setq value (get-property property (probe r property))))
     value))
 
+(defmethod clear-probed% ((r resource) (properties null))
+  (setf (probed-properties r) nil))
+
+(defmethod clear-probed% ((r resource) (property symbol))
+  (remf* (probed-properties r) property))
+
+(defmethod clear-probed% ((r resource) (properties cons))
+  (dolist (p properties)
+    (when p
+      (clear-probed r p))))
+
+(defun clear-probed (&optional (resource *localhost*) properties)
+  (clear-probed% resource properties))
+
 ;;  Conditions
 
 (defmethod print-object ((c resource-probe-not-found) stream)
diff --git a/core/properties.lisp b/core/properties.lisp
new file mode 100644
index 0000000..66f336e
--- /dev/null
+++ b/core/properties.lisp
@@ -0,0 +1,47 @@
+;;
+;;  adams  -  Remote system administration tools
+;;
+;;  Copyright 2013,2014 Thomas de Grivel <thomas@lowh.net>
+;;
+;;  Permission to use, copy, modify, and distribute this software for any
+;;  purpose with or without fee is hereby granted, provided that the above
+;;  copyright notice and this permission notice appear in all copies.
+;;
+;;  THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+;;  WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+;;  MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+;;  ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+;;  WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+;;  ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+;;  OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+;;
+
+(in-package :adams)
+
+;;  Properties implemented as property lists
+
+(defun properties (&rest keys-and-values)
+  (apply #'list keys-and-values))
+
+(defmacro properties* (&rest vars)
+  (when (and (consp (first vars))
+             (endp (rest vars)))
+    (setq vars (first vars)))
+  `(list ,@(iter (for v in vars)
+                 (collect (make-keyword v))
+                 (collect v))))
+
+(defmacro values* (&rest vars)
+  (when (and (consp (first vars))
+             (endp (rest vars)))
+    (setq vars (first vars)))
+  `(values ,@vars))
+
+(defun get-property (property properties)
+  (getf properties property +undefined+))
+
+(defsetf get-property (property properties) (value)
+  `(setf (getf ,properties ,property) ,value))
+
+(defun merge-properties (&rest properties)
+  (apply #'append properties))
diff --git a/core/resource-container.lisp b/core/resource-container.lisp
new file mode 100644
index 0000000..57d6727
--- /dev/null
+++ b/core/resource-container.lisp
@@ -0,0 +1,57 @@
+;;
+;;  adams  -  Remote system administration tools
+;;
+;;  Copyright 2013,2014 Thomas de Grivel <thomas@lowh.net>
+;;
+;;  Permission to use, copy, modify, and distribute this software for any
+;;  purpose with or without fee is hereby granted, provided that the above
+;;  copyright notice and this permission notice appear in all copies.
+;;
+;;  THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+;;  WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+;;  MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+;;  ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+;;  WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+;;  ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+;;  OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+;;
+
+(in-package :adams)
+
+;;  Resource registry
+
+(defun resource-registry-count (rr)
+  (hash-table-count rr))
+
+(defun clear-resource-registry (rr)
+  (clrhash rr))
+
+(defun get-resource (type id &optional (container (resource-registry
+                                                   *parent-resource*)))
+  (gethash (cons type id) container))
+
+(defsetf get-resource (type id &optional (container '(resource-registry
+                                                      *parent-resource*)))
+    (value)
+  `(setf (gethash (cons ,type ,id) ,container) ,value))
+
+(defun add-resource (parent child)
+  (setf (get-resource (resource-type child)
+                      (resource-id child)
+		      parent)
+	child))
+
+;;  Resource container
+
+(defmethod print-object ((rc resource-container) stream)
+  (print-unreadable-object (rc stream :type t :identity (not *print-pretty*))
+    (format stream "~S ~D spec ~D probed ~D resources" (resource-id rc)
+	    (/ (length (specified-properties rc)) 2)
+	    (/ (length (probed-properties rc)) 2)
+	    (resource-registry-count (resource-registry rc)))))
+
+(defmethod clear-resources% ((rc resource-container))
+  (clear-resource-registry (resource-registry rc)))
+
+(defun clear-resources (&optional (resource-container *parent-resource*))
+  (clear-resources% resource-container))
diff --git a/core/resource.lisp b/core/resource.lisp
index a061fda..dec99b8 100644
--- a/core/resource.lisp
+++ b/core/resource.lisp
@@ -24,6 +24,10 @@
   (setf (slot-value rc 'probes)
 	(compute-probes rc)))
 
+(defmethod slot-unbound (metaclass (rc resource-class) (slot-name (eql 'probes)))
+  (closer-mop:finalize-inheritance rc)
+  (slot-value rc 'probes))
+
 ;;  Resource
 
 (defmethod print-object ((r resource) stream)
@@ -56,21 +60,53 @@
 #+nil
 (probe-all-properties (resource 'file "/"))
 
-;;  Resource tree
-
-(defmethod print-object ((r resource-tree) stream)
-  (print-unreadable-object (r stream :type t :identity (not *print-pretty*))
-    (format stream "~S ~D spec ~D probed ~D nested" (resource-id r)
-	    (/ (length (specified-properties r)) 2)
-	    (/ (length (probed-properties r)) 2)
-	    (hash-table-count (resources-of r)))))
+(defun pprint-plist (plist &optional (stream *standard-output*))
+  (pprint-logical-block (stream plist)
+    (iter (for* (k v) in plist)
+          (for first-line-p initially t then nil)
+          (unless first-line-p
+            (pprint-newline :mandatory stream))
+          (write k :stream stream)
+          (write-char #\Space stream)
+          (write v :stream stream))))
 
-;;  High level API
-
-(defmacro get-resource (type id &optional (resources '*resources*))
-  `(gethash (cons ,type ,id) ,resources))
+#+nil
+(pprint-plist '(:a "aaa" :b "foo" :xyz "bar"))
+
+(defmethod describe-probed% ((res resource) (out (eql :form)))
+  (let* ((props (probe-all-properties res))
+         (sorted-keys (sort (iter (for* (k v) in props)
+                                  (collect k))
+                            #'string<))
+         (sorted-props (iter (for key in sorted-keys)
+                             (collect key)
+                             (collect (get-property key props)))))
+    `(resource ',(class-name (class-of res))
+               ,(resource-id res)
+               ,@sorted-props)))
+
+(defmethod describe-probed% ((res resource) (out null))
+  (with-output-to-string (str)
+    (describe-probed res str)))
+
+(defmethod describe-probed% ((res resource) (out (eql t)))
+  (describe-probed res *standard-output*))
+
+(defmethod describe-probed% ((res resource) (out stream))
+  (let ((form (describe-probed res :form)))
+    (fresh-line out)
+    (pprint-logical-block (out form :prefix "(" :suffix ")")
+      (write (first form) :stream out)
+      (write-char #\Space out)
+      (write (second form) :stream out)
+      (write-char #\Space out)
+      (write (third form) :stream out)
+      (pprint-indent :block 1 out)
+      (pprint-newline :mandatory out)
+      (pprint-plist (cdddr form) out))))
+
+(defun describe-probed (resource &optional (output t))
+  (describe-probed% resource output))
 
-(defun add-resource (parent child)
-  (setf (get-resource (resource-type child) (resource-id child)
-		      (resources-of parent))
-	child))
+#+nil
+(describe-probed (resource 'mount "/rd") t)
diff --git a/core/spec.lisp b/core/spec.lisp
index a475d13..f3fa3a8 100644
--- a/core/spec.lisp
+++ b/core/spec.lisp
@@ -22,7 +22,7 @@
 
 (defmethod specified-property ((res resource)
 			       (property symbol))
-  (let ((value (getf (specified-properties res) property +undefined+)))
+  (let ((value (get-property property (specified-properties res))))
     (when (eq +undefined+ value)
       (error "Property ~S not specified for ~S." property res))
     value))
@@ -30,7 +30,7 @@
 (defmethod (setf specified-property) (value
 				      (res resource)
 				      (property symbol))
-  (setf (getf (specified-properties res) property) value))
+  (setf (get-property property (specified-properties res)) value))
 
 ;;  Parse specifications
 
@@ -40,18 +40,27 @@
     (setf (specified-property res property) value)
     spec))
 
-(defmethod parse-next-specification ((res resource-tree) spec)
+(defmethod parse-next-specification ((res resource-container) spec)
   (cond ((typep (first spec) 'resource)
 	 (add-resource res (pop spec))
 	 spec)
 	(:otherwise (call-next-method))))
 
+(defmethod parse-specification ((res resource) (spec null))
+  res)
+
 (defmethod parse-specification ((res resource) (spec cons))
   (iter (while spec)
 	(for next-spec = (parse-next-specification res spec))
 	(when (eq spec next-spec)
 	  (error "Invalid specification : ~S" spec))
-	(setq spec next-spec)))
+	(setq spec next-spec))
+  res)
+
+
+#+nil
+(parse-specification *localhost*
+                     '(:hostname "arrakis.lowh.net"))
 
 (defmethod subclasses ((class class))
   (let (r)
@@ -78,3 +87,36 @@
 		      (subclasses (find-class 'resource)))
      (parse-specification *localhost*
 			  (list ,@specification))))
+
+#+nil
+(specify (user "billitch" :uid 19256 :group (group "billitch")))
+
+;;  Methods for matching specified and probed values
+
+(defgeneric match-specified-value (specified probed))
+
+(defmethod match-specified-value (specified probed)
+  (equalp specified probed))
+
+(defmethod match-specified-value ((specified resource) probed)
+  (equalp (resource-id specified) probed))
+
+;;  Methods to get current status of resource
+
+(defgeneric resource-diff (resource)
+  (:documentation "Two values are returned :
+First value lists properties out of specification in the following format :
+  (PROPERTY-NAME SPECIFIED-VALUE PROBED-VALUE).
+Second value lists properties in line with spec. Format is
+  (PROPERTY-NAME VALUE)"))
+
+(defmethod resource-diff ((res resource))
+  (iter (for* (property specified) in (specified-properties res))
+        (for probed = (get-probed res property))
+        (if (match-specified-value specified probed)
+            (collect `(,property ,specified) into ok)
+            (collect `(,property ,specified ,probed) into diff))
+        (finally (return (values diff ok)))))
+
+#+nil
+(resource-diff (resource 'directory "/" :owner "root" :uid 0))
diff --git a/core/syntaxes.lisp b/core/syntaxes.lisp
new file mode 100644
index 0000000..c79f298
--- /dev/null
+++ b/core/syntaxes.lisp
@@ -0,0 +1,62 @@
+;;
+;;  adams  -  Remote system administration tools
+;;
+;;  Copyright 2013,2014 Thomas de Grivel <thomas@lowh.net>
+;;
+;;  Permission to use, copy, modify, and distribute this software for any
+;;  purpose with or without fee is hereby granted, provided that the above
+;;  copyright notice and this permission notice appear in all copies.
+;;
+;;  THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+;;  WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+;;  MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+;;  ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+;;  WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+;;  ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+;;  OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+;;
+
+(in-package :adams)
+
+(in-re-readtable)
+
+;;  Simple regexp-based parser generator with ITERATE support
+
+(defmacro define-syntax (name vars re &body body)
+  (let ((parse-name (sym 'parse- name))
+	(doc (when (stringp (first body)) (pop body)))
+	(values (or (first (last body))
+		    `(values ,@(iter (for spec in vars)
+				     (if (consp spec)
+					 (dolist (var (cdr spec))
+					   (collect var))
+					 (collect spec)))))))
+    `(progn
+       (defun ,parse-name (line)
+	 ,@(when doc (list doc))
+	 (re-bind ,re ,vars line
+	   ,@(or body `(,values))))
+       (iterate:defmacro-clause (,name iter-vars in lines)
+	 ,@(when doc (list doc))
+	 (let ((line (gensym ,(format nil "~A-LINE-" (symbol-name name)))))
+	   `(progn (for ,line in ,lines)
+		   (for (values ,@iter-vars) = (,',parse-name ,line))))))))
+
+;;  Host
+
+(defun parse-uptime (string)
+  (or (re-bind #~|^\s*([0-9]+ days,\s*)?([0-9]+):([0-9]+)\s*$| (d h m) string
+        (* 60 (+ (parse-integer m)
+                 (* 60
+                    (+ (parse-integer h)
+                       (if d
+                           (* 24 (parse-integer d :junk-allowed t))
+                           0))))))
+      (error "Invalid uptime ?")))
+
+(define-syntax uptime<1> ((#'chronicity:parse time)
+                          (#'parse-uptime uptime)
+                          (#'parse-integer users)
+                          (#'parse-number load1 load5 load15))
+  #~|^\s*(\S+)\s+up\s+(.+), ([0-9]+) users?, load averages: ([0-9.]+), ([0-9.]+), ([0-9.]+)$|
+  "Syntax of the group permissions file /etc/group. See group(5).")
diff --git a/package.lisp b/package.lisp
index 6ab296e..58055c4 100644
--- a/package.lisp
+++ b/package.lisp
@@ -19,9 +19,10 @@
 (in-package :cl-user)
 
 (defpackage :adams
-  (:use :alexandria :cl :debug :iterate :re :str)
+  (:use :alexandria :cl :debug :iterate :parse-number :re :str)
   (:shadow #:directory)
   (:export
+   #:*adams*
    ;;  Shell
    #:*default-shell-command*
    #:*shell-signal-errors*
@@ -60,14 +61,21 @@
    #:resource-class
    ;;  Resource
    #:add-resource
+   #:describe-probed
    #:get-resource
    #:make-resource
    #:make-*resources*
    #:probed-properties
+   #:probe-all-properties
    #:resource
    #:resource-type
    #:specified-properties
    #:specified-property
+   ;;  Resource container
+   #:*parent-resource*
+   #:clear-resources
+   #:resource-container
+   #:with-parent-resource
    ;;  Specification
    #:specify
    #:parse-specification
@@ -86,11 +94,13 @@
    #:os-version
    #:os-windows
    ;;  Probing resources
+   #:clear-probed
    #:find-probe
    #:get-probed
    #:resource-probe-error
    #:resource-probe-not-found
    #:resource-probe-failed
+   #:resource-diff
    ;;  Host
    #:*host*
    #:host
@@ -105,24 +115,28 @@
    #:with-connected-host
    #:with-host
    ;;  Unix
-   #:+timestamp-offset+
-   #:timestamp-to-universal-time
-   #:universal-time-to-timestamp
-   #:grep
+   #:define-syntax
+   #:directory
    #:egrep
-   #:stat
+   #:file
+   #:grep
    #:group
-   #:define-syntax
-   #:parse-group<5>
    #:group<5>
-   #:user
+   #:mount
+   #:parse-group<5>
    #:parse-passwd<5>
-   #:passwd<5>
-   #:file
    #:parse-stat<1>
-   #:stat<1>))
+   #:passwd<5>
+   #:process
+   #:stat
+   #:stat<1>
+   #:+timestamp-offset+
+   #:timestamp-to-universal-time
+   #:universal-time-to-timestamp
+   #:user))
 
 (defpackage :adams-user
-  (:use :adams :cl :cl-debug))
+  (:use :adams :cl :cl-debug :re)
+  (:shadow #:directory))
 
 (setf (symbol-function 'adams::directory) #'cl:directory)
diff --git a/unix/defs.lisp b/unix/defs.lisp
index fc61eea..f9f81a6 100644
--- a/unix/defs.lisp
+++ b/unix/defs.lisp
@@ -18,36 +18,95 @@
 
 (in-package :adams)
 
+;;  Group
+
 (define-resource-class group () ()
   ((probe-group-in-/etc/group :properties (:name :passwd :gid :members))))
 
+(defgeneric probe-group-in-/etc/group (resource os))
+
+;;  User
+
 (define-resource-class user ()
   ()
-  ((probe-user-in-/etc/passwd :properties (login uid gid realname home shell))
+  ((probe-user-in-/etc/passwd :properties (:login :uid :gid :realname :home
+                                           :shell))
    (probe-user-groups-in-/etc/group :properties (:groups))))
 
+(defgeneric probe-user-in-/etc/passwd (resource os))
+(defgeneric probe-user-groups-in-/etc/group (resource os))
+
+;;  Filesystem virtual node
+
 (define-resource-class vnode ()
   ()
-  ((probe-vnode-using-ls :properties (mode links owner group size mtime))
+  ((probe-vnode-using-ls :properties (:mode :links :owner :group :size :mtime))
    (probe-vnode-using-stat :properties (:dev :ino :mode :links :uid :gid :rdev
                                         :size :atime :mtime :ctime :blksize
                                         :blocks :flags))))
 
+(defgeneric probe-vnode-using-ls (resource os))
+(defgeneric probe-vnode-using-stat (resource os))
+
+;;  File
+
 (eval-when (:compile-toplevel :load-toplevel :execute)
 
   (defvar *cksum-legacy-algorithms*
     '(:cksum :sum :sysvsum))
 
   (defvar *cksum-algorithms*
-    `(:md4 :md5 :rmd160 :sha1 :sha224 :sha256 :sha384 :sha512 ,@*cksum-legacy-algorithms*)))
+    `(:md4 :md5 :rmd160 :sha1 :sha224 :sha256 :sha384 :sha512
+           ,@*cksum-legacy-algorithms*)))
+
+(defvar *probe-file-content-size-limit* 8192)
 
 (define-resource-class file (vnode)
   ()
-  ((probe-file-content :properties (content))
+  ((probe-file-content :properties (:content))
    . #.(iter (for algorithm in *cksum-algorithms*)
 	     (collect `(,(sym 'probe-file-cksum- algorithm)
 			 :properties (,algorithm))))))
 
+(defgeneric probe-file-content (resource os))
+
+;;  Directory
+
 (define-resource-class directory (vnode)
   ()
   ((probe-directory-content :properties (:content))))
+
+(defgeneric probe-directory-content (resource os))
+
+;;  Mounted filesystems
+
+(define-resource-class mount ()
+  ()
+  ((probe-mount :properties (:mounted-device
+                             :mounted-mount-point
+                             :mounted-fstype
+                             :mounted-options))
+   (probe-fstab :properties (:fstab-device
+                             :fstab-mount-point
+                             :fstab-fstype
+                             :fstab-options
+                             :fstab-freq
+                             :fstab-passno))))
+
+(defgeneric probe-mount (resource os))
+(defgeneric probe-fstab (resource os))
+
+;;  Process
+
+(define-resource-class process ()
+  ()
+  ((probe-ps-auxww :properties (:user :pid :cpu :mem :vsz :rss :tt :state
+                                :start :time :cmd))))
+
+(defmethod probe-ps-auxww (process os))
+
+;;  Software package
+
+(define-resource-class pkg)
+
+(defgeneric probe-installed-packages% (host os))
diff --git a/unix/openbsd.lisp b/unix/openbsd.lisp
index af6e516..a44cbe1 100644
--- a/unix/openbsd.lisp
+++ b/unix/openbsd.lisp
@@ -18,8 +18,47 @@
 
 (in-package :adams)
 
-(define-resource-class openbsd-pkg ()
+(in-re-readtable)
+
+(define-resource-class openbsd-pkg (pkg)
   ()
-  (probe-openbsd-pkg :properties (flavor version)))
+  ((probe-openbsd-pkg :properties (:name :version :flavors))))
+
+(define-syntax pkg_info<1> (name version flavors)
+  #~|\s*((?:[^-\s]+)(?:-[^-0-9\s][^-\s]*)*)-([0-9][^-\s]*)(-[^\s]+)?|
+  "Syntax for pkg_info(1) on OpenBSD"
+  (values name version (re-matches #~|[^-]+| flavors)))
+
+(defgeneric probe-openbsd-pkg (resource os))
+
+(defmethod probe-openbsd-pkg ((pkg openbsd-pkg) (os os-openbsd))
+  (let ((id (resource-id pkg)))
+    (multiple-value-bind #1=(name version flavors)
+      (iter (pkg_info<1> #1# in
+                         (run "pkg_info | egrep ~A" (sh-quote (str "^" id "-"))))
+            (when (string= id name)
+              (return (values* #1#))))
+      (properties* #1#))))
+
+(defmethod probe-installed-packages% ((host host) (os os-openbsd))
+  (with-host host
+    (iter (pkg_info<1> #1=(name version flavors)
+                       in (run "pkg_info"))
+          (for pkg = (resource 'openbsd-pkg name))
+          (add-probed-properties pkg (properties* #1#))
+          (collect pkg))))
+
+(defun probe-installed-packages (&optional (host *host*))
+  (probe-installed-packages% host (host-os host)))
+
+#+nil
+(clear-resources)
+
+#+nil
+(describe-probed (resource 'openbsd-pkg "emacs"))
+
+#+nil
+(probe-installed-packages *localhost* (host-os *localhost*))
 
+#+nil
 (run "pkg_info -q | grep emacs-")
diff --git a/unix/probes.lisp b/unix/probes.lisp
index 86fa336..b4369e9 100644
--- a/unix/probes.lisp
+++ b/unix/probes.lisp
@@ -22,105 +22,165 @@
 
 (defmethod probe-group-in-/etc/group ((group group) (os os-unix))
   (let ((id (resource-id group)))
-    (iter (group<5> (name passwd gid members) in (grep (str id) "/etc/group"))
-	  (when (etypecase id
-		  (integer (= id gid))
-		  (string (string= id name)))
-	    (return (list :name name
-			  :passwd passwd
-			  :gid gid
-			  :members members))))))
+    (multiple-value-bind #1=(name passwd gid members)
+      (iter (group<5> #1# in (grep (str id) "/etc/group"))
+            (when (etypecase id
+                    (integer (= id gid))
+                    (string (string= id name)))
+              (return (values* #1#))))
+      (properties* #1#))))
 
 ;;  User
 
 (defmethod probe-user-in-/etc/passwd ((user user) (os os-unix))
   (let ((id (resource-id user)))
-    (iter (passwd<5> (login pass uid gid realname home shell)
-		     in (etypecase id
-			  (integer (grep (str #\: id #\:) "/etc/passwd"))
-			  (string (egrep (str #\^ id #\:) "/etc/passwd"))))
-	  (when (etypecase id
-		  (string (string= id login))
-		  (integer (= id uid)))
-	    (return (list :login login :uid uid :gid gid
-			  :realname realname :home home :shell shell))))))
+    (multiple-value-bind #1=(login pass uid gid realname home shell)
+      (iter (passwd<5> #1# in
+                       (etypecase id
+                         (integer (grep (str #\: id #\:) "/etc/passwd"))
+                         (string (egrep (str #\^ id #\:) "/etc/passwd"))))
+            (when (etypecase id
+                    (string (string= id login))
+                    (integer (= id uid))))
+	    (return (values* #1#)))
+      (properties* #1#))))
 
 (defmethod probe-user-groups-in-/etc/group ((user user) (os os-unix))
   (let* ((id (resource-id user))
 	 (user-login (if (stringp id)
 			 id
 			 (get-probed user :login)))
-	 (user-gid (get-probed user :gid)))
-    (iter (group<5> (name passwd gid members) in (grep user-login
-						       "/etc/group"))
-	  (with user-group = nil)
-	  (cond ((= user-gid gid) (setq user-group name))
-		((find user-login members :test #'string=) (collect name into groups)))
-	  (finally (let ((groups (sort groups #'string<)))
-		     (return (list :groups (if user-group
-					       (cons user-group groups)
-					       groups))))))))
+	 (user-gid (get-probed user :gid))
+         (user-group nil)
+         (groups (iter (group<5> (name passwd gid members)
+                                 in (grep user-login "/etc/group"))
+                       (cond ((= user-gid gid)
+                              (setq user-group name))
+                             ((find user-login members :test #'string=)
+                              (collect name)))))
+         (groups (sort groups #'string<))
+         (groups (if user-group
+                     (cons user-group groups)
+                     groups)))
+    (properties* groups)))
 
 ;;  VNode (filesystem node)
 
 (defmethod probe-vnode-using-ls ((vnode vnode) (os os-unix))
   (let ((id (resource-id vnode)))
-    (iter (ls<1>-lT (name mode links owner group size mtime)
-		    in (ls "-ldT" id))
-	  (when (string= id name)
-	    (return (list :mode mode
-			  :links links
-			  :owner owner
-			  :group group
-			  :size size
-			  :mtime mtime))))))
+    (multiple-value-bind #1=(mode links owner group size mtime)
+      (iter (ls<1>-lT #.(cons 'name '#1#)
+                      in (ls "-ldT" id))
+            (when (string= id name)
+              (return (values* #1#))))
+      (properties* #1#))))
 
 (defmethod probe-vnode-using-stat ((vnode vnode) (os os-unix))
   (let ((id (resource-id vnode)))
-    (iter (stat<1>-r (name dev ino mode links uid gid rdev size
-			   atime mtime ctime blksize blocks flags)
-		     in (stat "-r" id))
-	  (when (string= id name)
-	    (return (list :dev dev
-			  :ino ino
-			  :mode (mode-string mode)
-			  :links links
-			  :uid uid
-			  :gid gid
-			  :rdev rdev
-			  :size size
-			  :atime atime
-			  :mtime mtime
-			  :ctime ctime
-			  :blksize blksize
-			  :blocks blocks
-			  :flags flags))))))
+    (multiple-value-bind #1=(dev ino mode links uid gid rdev size
+                                 atime mtime ctime blksize blocks flags)
+      (iter (stat<1>-r #.(cons 'name '#1#)
+                       in (stat "-r" id))
+            (when (string= id name)
+              (setq mode (mode-string mode))
+              (return (values* #1#))))
+      (properties* #1#))))
 
 ;;  Regular file
 
 #.(cons 'progn
 	(iter (for algorithm in *cksum-algorithms*)
-              (for legacy = (member algorithm *cksum-legacy-algorithms*))
 	      (for name = (sym 'probe-file-cksum- algorithm))
+              (for legacy = (member algorithm *cksum-legacy-algorithms*))
+              (for iterator = (if legacy
+                                  'cksum<1>-legacy
+                                  'cksum<1>))
+              (for vars = (if legacy
+                              '(sum size name)
+                              '(algo name sum)))
+              (for cmd = (str "cksum -a " algorithm " ~A"))
+              (for match-p = (if legacy
+                                 `(string= id name)
+                                 `(and (string= ,algorithm algo)
+                                       (string= id name))))
+              (for var = (sym algorithm))
 	      (collect `(defgeneric ,name (file os)))
 	      (collect `(defmethod ,name ((file file) (os os-unix))
-			  (let ((id (resource-id file)))
-			    (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)
+			  (let* ((id (resource-id file))
+                                 (,var (iter (,iterator ,vars
+                                                        in (run ,cmd
+                                                                (sh-quote id)))
+                                             (when ,match-p
+                                               (return sum)))))
+                            (properties* ,var))))))
 
 (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))))))
+  (let* ((size (get-probed file :size))
+         (content (when size
+                    (if (< size *probe-file-content-size-limit*)
+                        (run "cat ~A" (sh-quote (resource-id file)))
+                        :file-too-large))))
+    (properties* content)))
+
+;;  Directory
+
+(defmethod probe-directory-content ((dir directory) (os os-unix))
+  (let ((content (remove-if (lambda (f)
+                              (or (string= "." f)
+                                  (string= ".." f)))
+                            (run "ls -1a ~A" (resource-id dir)))))
+    (properties* content)))
+
+;;  Mounts
+
+(defmethod probe-mount ((m mount) (os os-unix))
+  (let ((id (resource-id m)))
+    (multiple-value-bind (dev mp fstype options)
+        (iter (mount<8> (dev mp fstype options)
+                        in (run "mount | grep ~A"
+                                (sh-quote (str id " "))))
+              (when (or (string= id dev)
+                        (string= id mp))
+                (return (values dev mp fstype options))))
+      (properties :mounted-device dev
+                  :mounted-mount-point mp
+                  :mounted-fstype fstype
+                  :mounted-options options))))
+
+(defmethod probe-fstab ((m mount) (os os-unix))
+  (let ((id (resource-id m)))
+    (multiple-value-bind (dev mp fstype options freq passno)
+        (iter (fstab<5> (dev mp fstype options freq passno)
+                        in (run "grep ~A /etc/fstab"
+                                (sh-quote (str id " "))))
+              (when (or (string= id dev)
+                        (string= id mp))
+                (return (values dev mp fstype options freq passno))))
+      (properties :fstab-device dev
+                  :fstab-mount-point mp
+                  :fstab-fstype fstype
+                  :fstab-options options
+                  :fstab-freq freq
+                  :fstab-passno passno))))
+
+#+nil
+(probe-all-properties (resource 'mount "/"))
+
+;;  Processes
+
+(defmethod probe-ps-auxww ((process process) (os os-unix))
+  (let ((id (resource-id process)))
+    (multiple-value-bind #1=(user pid cpu mem vsz rss tt state start time cmd)
+        (iter (ps<1>-u #1# in (run "ps auxww | grep ~A" (sh-quote id)))
+              (print #.(cons 'list '#1#))
+              (when (typecase id
+                      (integer (= id pid))
+                      (string (and (<= (length id) (length cmd))
+                                   (string= id cmd :end2 (length id))
+                                   (or (= (length id) (length cmd))
+                                       (char= #\Space (char cmd (length id)))))))
+                (return (values* #1#))))
+      (properties* #1#))))
+
+#+nil
+(probe-all-properties (resource 'process "svscan"))
diff --git a/unix/syntaxes.lisp b/unix/syntaxes.lisp
index afb1492..f5c15d2 100644
--- a/unix/syntaxes.lisp
+++ b/unix/syntaxes.lisp
@@ -20,28 +20,6 @@
 
 (in-re-readtable)
 
-;;  Simple regexp-based parser generator with ITERATE support
-
-(defmacro define-syntax (name vars re &body body)
-  (let ((parse-name (sym 'parse- name))
-	(doc (when (stringp (first body)) (pop body)))
-	(values (or (first (last body))
-		    `(values ,@(iter (for spec in vars)
-				     (if (consp spec)
-					 (dolist (var (cdr spec))
-					   (collect var))
-					 (collect spec)))))))
-    `(progn
-       (defun ,parse-name (line)
-	 ,@(when doc (list doc))
-	 (re-bind ,re ,vars line
-	   ,@(or body `(,values))))
-       (iterate:defmacro-clause (,name iter-vars in lines)
-	 ,@(when doc (list doc))
-	 (let ((line (gensym ,(format nil "~A-LINE-" (symbol-name name)))))
-	   `(progn (for ,line in ,lines)
-		   (for (values ,@iter-vars) = (,',parse-name ,line))))))))
-
 ;;  Syntaxes
 
 (define-syntax group<5> (name passwd
@@ -84,3 +62,31 @@
 (define-syntax cksum<1> (algo sum file)
     #~|(\S+) \((.*)\) = (\S+)|
   "Syntax for cksum(1) output.")
+
+(define-syntax mount<8> (device mp type options)
+    #~|^\s*(\S+)\s+on\s+(\S+)\s+type\s+(\S+)\s+\(([^\)]+)\)|
+  "Syntax for mount(8) list of mounted filesystems."
+  (values device mp type (re-matches #~|[^\s,]+| options)))
+
+(define-syntax fstab<5> (device mp type options freq passno)
+    #~|^\s*([^\s#]+)\s+([^\s#]+)\s+([^\s#]+)\s+([^\s#]+)\s+([^\s#]+)\s+([^\s#]+)|
+  "Syntax for /etc/fstab, see fstab(5)."
+  (values device mp type
+          (re-matches #~|[^,]+| options)
+          (parse-integer freq)
+          (parse-integer passno)))
+
+(defun parse-ps-time (string)
+  (or (re-bind #~|^\s*([0-9]+):([0-9]*\.[0-9]*)$| (d h) string
+        (+ (* 3600 24 (the non-negative-fixnum (parse-integer d)))
+           (truncate (* 3600 (parse-number h)))))
+      (error "Invalid ps(1) time ?")))
+
+(define-syntax ps<1>-u (user
+                        (#'parse-number pid cpu mem vsz rss)
+                        tt state
+                        (#'chronicity:parse start)
+                        (#'parse-ps-time time)
+                        cmd)
+    #~|^\s*(\S+)\s+([0-9]+)\s+([0-9.]+)\s+([0-9.]+)\s+([0-9]+)\s+([0-9]+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(.*)$|
+  "Syntax for ps -u, see ps(1).")