thodg/cl-unix-cybernetics

diff --git a/adams.asd b/adams.asd
index 58754be..622cb52 100644
--- a/adams.asd
+++ b/adams.asd
@@ -52,6 +52,7 @@
                                               "syntaxes"))
 	     (:file "os")
 	     (:file "probe"      :depends-on ("defs" "host" "properties"))
+	     (:file "operation"  :depends-on ("defs" "host" "properties"))
 	     (:file "properties" :depends-on ("defs"))
 	     (:file "resource"   :depends-on ("defs" "probe"))
 	     (:file "resource-container" :depends-on ("defs"))
diff --git a/core/defs.lisp b/core/defs.lisp
index 6749e73..6267e7e 100644
--- a/core/defs.lisp
+++ b/core/defs.lisp
@@ -49,11 +49,15 @@
 (defclass operation ()
   ((name :initarg :name
 	 :initform (error "Operation without a name.")
-	 :reader op-name
+	 :reader operation-name
 	 :type symbol)
    (properties :initarg :properties
 	       :initform (error "Operation without properties.")
-	       :reader op-properties)))
+	       :reader operation-properties)
+   (after :initarg :after
+          :reader operations-before)))
+
+(defgeneric operation-generic-function (op))
 
 ;;  Resource metaclass
 
@@ -64,14 +68,14 @@
 		  :initform ()
 		  :reader direct-probes
 		  :type list)
-   (direct-ops :initarg :direct-ops
-	       :initform ()
-	       :reader direct-ops
-	       :type list)
+   (direct-operations :initarg :direct-operations
+                      :initform ()
+                      :reader direct-operations
+                      :type list)
    (probes :reader probes-of
 	   :type list)
-   (ops :reader ops-of
-	:type list))
+   (operations :reader operations-of
+               :type list))
   (:default-initargs :direct-superclasses (list *the-resource-class*)))
 
 (defmethod closer-mop:validate-superclass ((c resource-class)
@@ -87,7 +91,7 @@
   `(defclass ,name ,(or direct-superclasses
 			'(resource))
      ,direct-slots
-     (:direct-ops ,@direct-ops)
+     (:direct-operations ,@direct-ops)
      (:direct-probes ,@direct-probes)
      (:metaclass resource-class)
      ,@options))
@@ -95,6 +99,9 @@
 (defgeneric probe-class (resource-class))
 (defgeneric compute-probes (resource-class))
 
+(defgeneric operation-class (resource-class))
+(defgeneric compute-operations (resource-class))
+
 ;;  Resource base class
 
 (defclass resource (standard-object)
@@ -213,6 +220,24 @@
 (define-condition resource-probe-failed (resource-probe-error)
   ((probe :initarg :probe)))
 
+;;  Operating on resources
+
+(defgeneric find-operation (resource property os))
+(defgeneric operate (resource plist))
+
+(define-condition resource-operation-error (error)
+  ((resource :initarg :resource)
+   (host :initarg :host
+	 :initform (current-host))
+   (os :initarg :os)))
+
+(define-condition resource-operation-not-found (resource-operation-error)
+  ((property :initarg :property)))
+
+(define-condition resource-operation-failed (resource-operation-error)
+  ((operation :initarg :operation)
+   (diff :initarg :diff)))
+
 ;;  Operators on property lists
 
 (defmacro remf* (place indicator)
diff --git a/core/properties.lisp b/core/properties.lisp
index fd0cc75..41bedf7 100644
--- a/core/properties.lisp
+++ b/core/properties.lisp
@@ -40,6 +40,13 @@
 (defmacro get-property (property properties)
   `(getf ,properties ,property +undefined+))
 
+(defun get-properties (keys properties)
+  (iter (for k in keys)
+        (for v = (get-property k properties))
+        (unless (eq v +undefined+)
+          (collect k)
+          (collect v))))
+
 (defmethod compare-property-values (resource property value1 value2)
   (equalp value1 value2))
 
diff --git a/core/resource-container.lisp b/core/resource-container.lisp
index 0a84588..eff2679 100644
--- a/core/resource-container.lisp
+++ b/core/resource-container.lisp
@@ -46,6 +46,10 @@
 		      parent)
 	child))
 
+(iterate:defmacro-clause (for-resource var in container)
+  (let ((x (gensym)))
+    `(for (,x ,var) in-hashtable (resource-registry ,container))))
+
 ;;  Resource container
 
 (defmethod print-object ((rc resource-container) stream)
diff --git a/core/resource.lisp b/core/resource.lisp
index 3c892a6..e155faf 100644
--- a/core/resource.lisp
+++ b/core/resource.lisp
@@ -22,7 +22,9 @@
 
 (defmethod closer-mop:finalize-inheritance :after ((rc resource-class))
   (setf (slot-value rc 'probes)
-	(compute-probes rc)))
+	(compute-probes rc)
+        (slot-value rc 'operations)
+        (compute-operations rc)))
 
 (defmethod slot-unbound (metaclass (rc resource-class) (slot-name (eql 'probes)))
   (closer-mop:finalize-inheritance rc)
@@ -30,6 +32,9 @@
 
 ;;  Resource
 
+(defun resource-p (x)
+  (typep x 'resource))
+
 (defmethod print-object ((r resource) stream)
   (print-unreadable-object (r stream :type t :identity (not *print-pretty*))
     (format stream "~S ~D spec ~D probed" (resource-id r)
@@ -60,6 +65,13 @@
 #+nil
 (probe-all-properties (resource 'file "/"))
 
+(defmethod resource-operations-properties ((res resource))
+  (let ((properties))
+    (dolist (operation (operations-of res))
+      (dolist (property (operation-properties operation))
+        (pushnew property properties)))
+    (sort properties #'string<)))
+
 (defun pprint-plist (plist &optional (stream *standard-output*))
   (pprint-logical-block (stream plist)
     (iter (for* (k v) in plist)
diff --git a/core/spec.lisp b/core/spec.lisp
index 546bf3f..b68eba4 100644
--- a/core/spec.lisp
+++ b/core/spec.lisp
@@ -112,10 +112,25 @@ Second value lists properties in line with spec. Format is
 (defmethod resource-diff ((res resource))
   (iter (for* (property specified) in (specified-properties res))
         (for probed = (get-probed res property))
-        (if (match-specified-value res property specified probed)
+        (for desc = (describe-probed-property-value res property probed))
+        (if (match-specified-value res property specified desc)
             (collect `(,property ,specified) into ok)
-            (collect `(,property ,specified ,probed) into diff))
-        (finally (return (values diff ok)))))
+            (collect `(,property ,specified ,desc) into diff))
+        (finally (return diff))))
 
 #+nil
 (resource-diff (resource 'directory "/" :owner "root" :uid 0))
+
+(defmethod resource-diff ((res resource-container))
+  (append (call-next-method res)
+          (iter (for-resource r in res)
+                (for d = (resource-diff r))
+                (when d
+                  (collect (cons r d))))))
+
+(defun resource-diff-to-plist (diff)
+  (iter (for item in diff)
+        (for key = (first item))
+        (when (keywordp key)
+          (collect key)
+          (collect (second item)))))
diff --git a/package.lisp b/package.lisp
index 78b792b..9051687 100644
--- a/package.lisp
+++ b/package.lisp
@@ -20,7 +20,7 @@
 
 (defpackage :adams
   (:use :alexandria :cl :debug :iterate :parse-number :re :str)
-  (:shadow #:directory)
+  (:shadow #:directory #:get-properties)
   (:export
    #:*adams*
    ;;  Shell
diff --git a/unix/stat.lisp b/unix/stat.lisp
index 199c8b5..079ab2f 100644
--- a/unix/stat.lisp
+++ b/unix/stat.lisp
@@ -30,54 +30,100 @@
       (socket            #\s #o140000))
   :test #'equalp)
 
-(defun mode-string-type (mode-string)
-  (let ((c (char mode-string 0)))
-    (or (car (find c +stat-mode-types+ :key #'second :test #'char=))
-	(error "Unknown mode string type : ~S" c))))
-
-(defun mode-type (mode)
-  (let ((m (logand mode #o170000)))
-    (or (car (find m +stat-mode-types+ :key #'third :test #'=))
-	(error "Unknown mode type : #o~O." m))))
-
-(defun type-mode (type)
-  (or (third (find type +stat-mode-types+ :key #'car :test #'eq))
-      (error "Unknown type ~S." type)))
-
-(defun type-mode-char (type)
-  (or (second (find type +stat-mode-types+ :key #'car :test #'eq))
-      (error "Unknown type ~S." type)))
-
-(defun mode-string (mode)
-  (str (type-mode-char (mode-type mode))
-       (if (logtest     #o0400 mode) #\r #\-)
-       (if (logtest     #o0200 mode) #\w #\-)
-       (if (logtest     #o0100 mode)
-	   (if (logtest #o4000 mode) #\s #\x)
-	   (if (logtest #o4000 mode) #\S #\-))
-       (if (logtest     #o0040 mode) #\r #\-)
-       (if (logtest     #o0020 mode) #\w #\-)
-       (if (logtest     #o0010 mode)
-	   (if (logtest #o2000 mode) #\s #\x)
-	   (if (logtest #o2000 mode) #\S #\-))
-       (if (logtest     #o0004 mode) #\r #\-)
-       (if (logtest     #o0002 mode) #\w #\-)
-       (if (logtest     #o0001 mode)
-	   (if (logtest #o1000 mode) #\s #\x)
-	   (if (logtest #o1000 mode) #\S #\-))))
+(defun octal (number)
+  (format nil "0~O" number))
+
+(defclass mode ()
+  ((fixnum :initarg :fixnum
+           :initform 0
+           :type fixnum
+           :reader mode-fixnum)))
+
+(defgeneric mode-type (mode))
+(defgeneric mode-string (mode))
+(defgeneric mode-fixnum (mode))
+(defgeneric mode-octal (mode))
+(defgeneric mode (value))
+
+(defmethod mode-type ((mode fixnum))
+  (let ((type (logand #o170000 mode)))
+    (unless (zerop type)
+      type)))
+
+(defmethod mode-type ((mode mode))
+  (mode-type (mode-fixnum mode)))
+
+(defmethod mode-permissions ((mode mode))
+  (logand #o007777 (mode-fixnum mode)))
+
+(defmethod mode-string ((mode mode))
+  (let* ((num (mode-fixnum mode))
+         (type (mode-type num)))
+    (str (when type
+           (second (find type +stat-mode-types+ :key #'third)))
+         (if (logtest     #o0400 num) #\r #\-)
+         (if (logtest     #o0200 num) #\w #\-)
+         (if (logtest     #o0100 num)
+             (if (logtest #o4000 num) #\s #\x)
+             (if (logtest #o4000 num) #\S #\-))
+         (if (logtest     #o0040 num) #\r #\-)
+         (if (logtest     #o0020 num) #\w #\-)
+         (if (logtest     #o0010 num)
+             (if (logtest #o2000 num) #\s #\x)
+             (if (logtest #o2000 num) #\S #\-))
+         (if (logtest     #o0004 num) #\r #\-)
+         (if (logtest     #o0002 num) #\w #\-)
+         (if (logtest     #o0001 num)
+             (if (logtest #o1000 num) #\s #\x)
+             (if (logtest #o1000 num) #\S #\-)))))
+
+(defmethod mode-string (mode)
+  (mode-string (mode mode)))
+
+(defmethod mode-fixnum (mode)
+  (mode-fixnum (mode mode)))
+
+(defmethod mode-octal (mode)
+  (octal (mode-fixnum mode)))
 
 (defun parse-mode-string (s)
-  (declare (type (string 10) s))
-  (logior
-   (ecase (char s 0) (#\- 0) (#\r #o0400))
-   (ecase (char s 1) (#\- 0) (#\w #o0200))
-   (ecase (char s 2) (#\- 0) (#\x #o0100) (#\S #o4000) (#\s #o4100))
-   (ecase (char s 3) (#\- 0) (#\r #o0040))
-   (ecase (char s 4) (#\- 0) (#\w #o0020))
-   (ecase (char s 5) (#\- 0) (#\x #o0010) (#\S #o2000) (#\s #o2010))
-   (ecase (char s 6) (#\- 0) (#\r #o0004))
-   (ecase (char s 7) (#\- 0) (#\w #o0002))
-   (ecase (char s 8) (#\- 0) (#\x #o0001) (#\S #o1000) (#\s #o1001))))
+  (let ((type (when (= 10 (length s))
+                (let ((c (char s 0)))
+                  (setq s (subseq s 1))
+                  (or (find c +stat-mode-types+ :key #'cadr :test #'char=)
+                      (error "Unknown mode type : ~C" c))))))
+    (make-instance
+     'mode :fixnum
+     (logior
+      (if type (third type) 0)
+      (ecase (char s 0) (#\- 0) (#\r #o0400))
+      (ecase (char s 1) (#\- 0) (#\w #o0200))
+      (ecase (char s 2) (#\- 0) (#\x #o0100) (#\S #o4000) (#\s #o4100))
+      (ecase (char s 3) (#\- 0) (#\r #o0040))
+      (ecase (char s 4) (#\- 0) (#\w #o0020))
+      (ecase (char s 5) (#\- 0) (#\x #o0010) (#\S #o2000) (#\s #o2010))
+      (ecase (char s 6) (#\- 0) (#\r #o0004))
+      (ecase (char s 7) (#\- 0) (#\w #o0002))
+      (ecase (char s 8) (#\- 0) (#\x #o0001) (#\S #o1000) (#\s #o1001))))))
+
+(defmethod mode ((mode mode))
+  mode)
+
+(defmethod mode ((n fixnum))
+  (make-instance 'mode :fixnum n))
+
+(defmethod mode ((s string))
+  (if (char<= #\0 (char s 0) #\9)
+      (make-instance 'mode :fixnum (parse-integer s :radix 8))
+      (parse-mode-string s)))
+
+(defmethod print-object ((mode mode) stream)
+  (prin1 `(mode ,(if (mode-type mode)
+                     (mode-string mode)
+                     (mode-octal mode)))
+         stream))
+
+(mode "dr-xr-x---")
 
 (defun parse-unix-timestamp (x)
   (let ((n (typecase x