diff --git a/core/defs.lisp b/core/defs.lisp
index 9aaa643..b8d723c 100644
--- a/core/defs.lisp
+++ b/core/defs.lisp
@@ -76,7 +76,11 @@
(probes :reader probes-of
:type list)
(operations :reader operations-of
- :type list))
+ :type list)
+ (op-properties :initarg :op-properties
+ :initform ()
+ :reader op-properties
+ :type list))
(:default-initargs :direct-superclasses (list *the-resource-class*)))
(defmethod closer-mop:validate-superclass ((c resource-class)
diff --git a/core/operation.lisp b/core/operation.lisp
index 67478ff..58d151b 100644
--- a/core/operation.lisp
+++ b/core/operation.lisp
@@ -95,14 +95,52 @@
(push op operations)))
(nreverse operations)))
-(defun sort-operations (operations)
+(defgeneric resource-op-properties (resource))
+(defgeneric op-property-before-p (resource p1 p2))
+(defgeneric operation-before-p (resource op1 op2))
+(defgeneric sort-operations (resource operations))
+
+(trace resource-op-properties
+ op-properties
+ op-property-before-p
+ operation-before-p
+ sort-operations)
+
+(defmethod resource-op-properties ((res resource))
+ (op-properties (class-of res)))
+
+(defmethod op-property-before-p ((res resource) (p1 symbol) (p2 symbol))
+ (dolist (prop (resource-op-properties res))
+ (cond ((endp prop) (return nil))
+ ((eq p1 (first prop)) (return t))
+ ((eq p2 (first prop)) (return nil)))
+ (pop prop)))
+
+(defmethod operation-before-p ((res resource) (op1 operation)
+ (op2 operation))
+ (declare (type operation op1 op2))
+ (let ((op1-properties (operation-properties op1)))
+ (loop (when (endp op1-properties) (return))
+ (let ((p1 (pop op1-properties))
+ (op2-properties (operation-properties op2))
+ (before-p t))
+ (loop (when (endp op2-properties) (return))
+ (let ((p2 (pop op2-properties)))
+ (unless (op-property-before-p res p1 p2)
+ (setf before-p nil)
+ (return))))
+ (when before-p
+ (return-from operation-before-p t)))))
+ (find op1 (the list (operations-before op2))))
+
+(defmethod sort-operations ((res resource) (operations list))
(sort operations (lambda (op1 op2)
- (find op1 (operations-before op2)))))
+ (operation-before-p res op1 op2))))
(defmethod operate ((res resource) (plist list))
(let* ((os (host-os (current-host)))
(operations (list-operations res plist os))
- (sorted-ops (sort-operations operations))
+ (sorted-ops (sort-operations res operations))
(results))
(loop
(let* ((op (pop sorted-ops))
diff --git a/core/resource-container.lisp b/core/resource-container.lisp
index 008f6f4..0c15b80 100644
--- a/core/resource-container.lisp
+++ b/core/resource-container.lisp
@@ -46,19 +46,27 @@
parent)
child))
-(defmacro do-resources ((var) container &body body)
+(defmacro do-resources% ((var) container &body body)
(let ((x (gensym)))
`(maphash (lambda (,x ,var)
(declare (ignore ,x))
,@body)
(resource-registry ,container))))
-(defmethod child-resources ((res resource-container))
+(defmethod sorted-resources ((res resource-container))
(let ((resources))
- (do-resources (child) res
+ (do-resources% (child) res
(push child resources))
(sort resources #'resource-before-p)))
+(defmacro do-resources ((var) container &body body)
+ (let ((resources (gensym "RESOURCES-")))
+ `(let ((,resources (sorted-resources ,container)))
+ (loop (when (endp ,resources) (return))
+ (let ((,var (pop ,resources)))
+ (declare (type resource ,var))
+ ,@body)))))
+
;; Resource container
(defmethod print-object ((rc resource-container) stream)
@@ -78,3 +86,14 @@
(defmethod resource-before-p ((r1 resource) (r2 resource))
nil)
+
+;; Sync
+
+(defmethod sync :after ((res resource-container))
+ (with-parent-resource res
+ (let ((sorted-resources (sorted-resources res)))
+ (loop
+ (when (endp sorted-resources)
+ (return))
+ (let ((child (pop sorted-resources)))
+ (sync child))))))
diff --git a/core/resource.lisp b/core/resource.lisp
index c808f3b..782e4b1 100644
--- a/core/resource.lisp
+++ b/core/resource.lisp
@@ -188,7 +188,7 @@
(host (current-host))
(os (host-os host))
(ops (list-operations res plist os))
- (sorted-ops (sort-operations ops)))
+ (sorted-ops (sort-operations res ops)))
(loop
(when (endp sorted-ops)
(return))
@@ -198,17 +198,7 @@
(op-fun (operation-generic-function op)))
(apply op-fun res os op-plist)
(clear-probed res op-keys)
- (sync-op host res op op-keys op-plist os))))))
-
-(defmethod sync ((res resource-container))
- (call-next-method)
- (with-parent-resource res
- (let ((child-resources (child-resources res)))
- (loop
- (when (endp child-resources)
- (return))
- (let ((child (pop child-resources)))
- (sync child))))))
+ (sync-check host res op op-keys op-plist os))))))
(defmethod sync ((host host))
(with-host host
diff --git a/core/spec.lisp b/core/spec.lisp
index 7782432..632b992 100644
--- a/core/spec.lisp
+++ b/core/spec.lisp
@@ -117,31 +117,30 @@ Second value lists properties in line with spec. Format is
(defmethod resource-diff ((res resource))
(let ((specified-properties (specified-properties res))
- ok diff)
+ diff)
(loop
(when (endp specified-properties)
(return))
- (let* ((sp (pop specified-properties))
- (property (first sp))
- (specified (second sp))
+ (let* ((property (pop specified-properties))
+ (specified (pop specified-properties))
(probed (get-probed res property))
(desc (describe-probed-property-value res property probed)))
- (if (match-specified-value res property specified desc)
- (push sp ok)
- (push `(,property ,specified ,desc) diff))))
- diff))
+ (unless (match-specified-value res property specified desc)
+ (push `(,property ,specified ,desc) diff))))
+ (nreverse diff)))
#+nil
(resource-diff (resource 'directory "/" :owner "root" :uid 0))
(defmethod resource-diff ((res resource-container))
- (let ((diffs))
- (do-resources (r) res
- (let ((d (resource-diff r)))
- (when d
- (push (cons r d) diffs))))
- (append (call-next-method res)
- (sort diffs #'resource-before-p :key #'first))))
+ (with-parent-resource res
+ (let ((diffs))
+ (do-resources (r) res
+ (let ((d (resource-diff r)))
+ (when d
+ (push (cons r d) diffs))))
+ (append (call-next-method res)
+ (sort diffs #'resource-before-p :key #'first)))))
(defmethod resource-diff ((host host))
(with-host host