Skip to content
Browse files

Fix issues with cross-node configuration

When using delayed arguments or the post phase, to access parameters set in a
phase, there were several issues that masked the parameters. This also adds
tests for these use cases.
  • Loading branch information...
1 parent 4651c2f commit 8342743530ae4b4256ae879b491ec1548b486417 @hugoduncan hugoduncan committed Mar 23, 2011
Showing with 233 additions and 151 deletions.
  1. +29 −19 src/pallet/core.clj
  2. +4 −18 src/pallet/resource.clj
  3. +199 −110 test/pallet/core_test.clj
  4. +1 −4 test/pallet/resource_test.clj
View
48 src/pallet/core.clj
@@ -392,7 +392,7 @@ script that is run with root privileges immediatly after first boot."
[request results]
(reduce
(fn reduce-node-results-fn [request [result req :as arg]]
- (let [param-keys [:parameters :host (:target-id req)]]
+ (let [param-keys [:parameters]]
(->
request
(assoc-in [:results (:target-id req) (:phase req)] result)
@@ -421,6 +421,7 @@ script that is run with root privileges immediatly after first boot."
(defn- invoke-for-node
"Build an invocation map for specified node."
[request node]
+ {:pre [(:phase request)]}
(resource-invocations
(->
request
@@ -537,26 +538,38 @@ script that is run with root privileges immediatly after first boot."
(defn sequential-lift
"Sequential apply a phase."
- [request phase target-node-map]
+ [request target-node-map]
(apply
concat
- (for [[node-type tag-nodes] target-node-map
- :let [request (invoke-for-node-type
- (assoc request :phase phase)
- {node-type tag-nodes})]]
+ (for [[node-type tag-nodes] target-node-map]
(sequential-apply-phase (assoc request :node-type node-type) tag-nodes))))
(defn parallel-lift
"Apply a phase to nodes in parallel."
- [request phase target-node-map]
+ [request target-node-map]
(mapcat
#(map deref %) ; make sure all nodes complete before next phase
- (for [[node-type tag-nodes] target-node-map
- :let [request (invoke-for-node-type
- (assoc request :phase phase)
- {node-type tag-nodes})]]
+ (for [[node-type tag-nodes] target-node-map]
(parallel-apply-phase (assoc request :node-type node-type) tag-nodes))))
+(defn lift-nodes-for-phase
+ "Lift nodes in target-node-map for the specified phases.
+
+ Builds the commands for the phase, then executes pre-phase, phase, and
+ after-phase"
+ [request phase target-node-map]
+ (let [request (->
+ request
+ (assoc :phase phase)
+ (invoke-for-node-type target-node-map))
+ lift-fn (environment/get-for request [:algorithms :lift-fn])]
+ (reduce
+ (fn [request phase]
+ (let [request (assoc request :phase phase)]
+ (reduce-node-results request (lift-fn request target-node-map))))
+ request
+ (resource/phase-list phase))))
+
(defn lift-nodes
"Lift nodes in target-node-map for the specified phases."
[all-nodes target-node-map all-node-map phases request]
@@ -567,17 +580,14 @@ script that is run with root privileges immediatly after first boot."
; unmanged nodes
[request phases] (identify-anonymous-phases request phases)
request (assoc request :all-nodes all-nodes :target-nodes target-nodes)
- lift-fn (environment/get-for request [:algorithms :lift-fn])
request (invoke-phases
- request (ensure-configure-phase phases)
+ request phases
(utils/dissoc-keys all-node-map (keys target-node-map)))]
(reduce
(fn [request phase]
- (merge-phase-results
- request
- (reduce-node-results request (lift-fn request phase target-node-map))))
+ (lift-nodes-for-phase request phase target-node-map))
request
- (resource/phase-list phases))))
+ phases)))
(def
^{:doc
@@ -608,7 +618,7 @@ script that is run with root privileges immediatly after first boot."
(logging/trace (format "lift* phases %s" (vec (:phase-list request))))
(let [node-set (:node-set request)
all-node-set (:all-node-set request)
- phases (:phase-list request)
+ phases (or (:phase-list request) [:configure])
nodes (or
(:all-nodes request)
(when-let [compute (environment/get-for request [:compute] nil)]
@@ -633,7 +643,7 @@ script that is run with root privileges immediatly after first boot."
(logging/info "retrieving nodes")
(let [node-map (:node-map request)
all-node-set (:all-node-set request)
- phases (:phase-list request)
+ phases (or (:phase-list request) [:configure])
node-map (add-prefix-to-node-map (:prefix request) node-map)
compute (environment/get-for request [:compute])
nodes (compute/nodes compute)]
View
22 src/pallet/resource.clj
@@ -385,26 +385,12 @@ configuration code."
(recur rest request (if fn-result (conj result fn-result) result)))
[result request])))
-(defn phase-list*
- "Add pre and after phases"
- [phases]
- (lazy-seq
- (when (seq phases)
- (let [phase (first phases)]
- (if (keyword? phase)
- (cons (pre-phase phase)
- (cons phase
- (cons (after-phase phase)
- (phase-list* (rest phases)))))
- (cons (pre-phase (first phase))
- (cons phase
- (cons [(after-phase (first phase)) (second phase)]
- (phase-list* (rest phases))))))))))
-
(defn phase-list
"Add default phases, pre and after phases."
- [phases]
- (phase-list* (or (seq phases) (seq [:configure]))))
+ [phase]
+ (if (keyword? phase)
+ [(pre-phase phase) phase (after-phase phase)]
+ [(pre-phase (first phase)) (first phase) (after-phase (first phase))]))
(defn check-request-map
"Function that can check a request map to ensure it is a valid part of
View
309 test/pallet/core_test.clj
@@ -1,6 +1,7 @@
(ns pallet.core-test
(:use pallet.core)
(require
+ [pallet.argument :as argument]
[pallet.core :as core]
[pallet.utils :as utils]
[pallet.stevedore :as stevedore]
@@ -463,113 +464,201 @@
(deftest lift-with-runtime-params-test
;; test that parameters set at execution time are propogated
;; between phases
- (testing "serial"
- (let [node (make-node
- "localhost" {}
- :configure (fn [request]
- (resource/invoke-resource
- request
- (fn [request]
- (parameter/assoc-for-target request [:x] "x"))
- [] :in-sequence :fn/clojure))
- :configure2 (fn [request]
- (resource/invoke-resource
- request
- (fn [request]
- (is (= (parameter/get-for-target request [:x])
- "x"))
- "ls -d /")
- [] :in-sequence :script/bash)))
- localhost (node-list/make-localhost-node :tag "localhost")
- compute (compute/compute-service "node-list" :node-list [localhost])
- request (lift {node localhost}
- :phase [:configure :configure2]
- :compute compute
- :environment
- {:algorithms {:lift-fn sequential-lift}})]
- (is (map? request))
- (is (map? (-> request :results)))
- (is (map? (-> request :results first second)))
- (is (-> request :results :localhost :configure))
- (is (-> request :results :localhost :configure2))
- (let [{:keys [out err exit]} (-> request
- :results :localhost :configure2 first)]
- (is out)
- (is (= err ""))
- (is (zero? exit)))))
- (testing "parallel"
- (let [node (make-node
- "localhost" {}
- :configure (fn [request]
- (resource/invoke-resource
- request
- (fn [request]
- (parameter/assoc-for-target request [:x] "x"))
- [] :in-sequence :fn/clojure))
- :configure2 (fn [request]
- (resource/invoke-resource
- request
- (fn [request]
- (is (= (parameter/get-for-target request [:x])
- "x"))
- "ls -d /")
- [] :in-sequence :script/bash)))
- localhost (node-list/make-localhost-node :tag "localhost")
- compute (compute/compute-service "node-list" :node-list [localhost])
- request (lift {node localhost}
- :phase [:configure :configure2]
- :compute compute
- :environment
- {:algorithms {:lift-fn parallel-lift}})]
- (is (map? request))
- (is (map? (-> request :results)))
- (is (map? (-> request :results first second)))
- (is (-> request :results :localhost :configure))
- (is (-> request :results :localhost :configure2))
- (let [{:keys [out err exit]} (-> request
- :results :localhost :configure2 first)]
- (is out)
- (is (= err ""))
- (is (zero? exit))))))
-
-
-
-;; (deftest converge*-nodes-binding-test
-;; (defnode a {})
-;; (defnode b {})
-;; (let [na (test-utils/make-node "a")
-;; nb (test-utils/make-node "b")
-;; nc (test-utils/make-node "b" :name "b1" :running false)
-;; compute (compute/compute-service "node-list" :node-list [na nb nc])]
-;; (mock/expects [(sequential-apply-phase
-;; [request nodes]
-;; (do
-;; (is (= #{na nb} (set (:all-nodes request))))
-;; (is (= #{na nb} (set (:target-nodes request))))))
-;; (compute/nodes [& _] [na nb nc])]
-;; (converge*
-;; {a 1 b 1} nil [:configure]
-;; {:compute compute
-;; :middleware *middleware*}))))
-
-;; (deftest converge-test
-;; (let [id "a"
-;; request (with-middleware
-;; wrap-no-exec
-;; (converge {(make-node
-;; "a" {}
-;; :configure (fn [request]
-;; (resource/invoke-resource
-;; request
-;; (fn [request] "Hi")
-;; [] :in-sequence :script/bash)))
-;; 1} :compute nil))]
-;; (is (map? request))
-;; (is (map? (-> request :results)))
-;; (is (map? (-> request :results first second)))
-;; (is (:configure (-> request :results first second)))
-;; (is (some
-;; #(= "Hi\n" %)
-;; (:configure (-> request :results first second))))
-;; (is (= 1 (count (:all-nodes request))))
-;; (is (= 1 (count (compute/nodes))))))
+ (let [node (make-node
+ "localhost" {}
+ :configure (fn [request]
+ (resource/invoke-resource
+ request
+ (fn [request]
+ (parameter/assoc-for-target request [:x] "x"))
+ [] :in-sequence :fn/clojure))
+ :configure2 (fn [request]
+ (is (= (parameter/get-for-target request [:x])
+ "x"))
+ (resource/invoke-resource
+ request
+ (fn [request]
+ (format
+ "echo %s\n"
+ (parameter/get-for-target request [:x])))
+ [] :in-sequence :script/bash)))
+ localhost (node-list/make-localhost-node :tag "localhost")]
+ (testing "serial"
+ (let [compute (compute/compute-service "node-list" :node-list [localhost])
+ request (lift {node localhost}
+ :phase [:configure :configure2]
+ :compute compute
+ :environment
+ {:algorithms {:lift-fn sequential-lift}})]
+ (is (map? request))
+ (is (map? (-> request :results)))
+ (is (map? (-> request :results first second)))
+ (is (-> request :results :localhost :configure))
+ (is (-> request :results :localhost :configure2))
+ (let [{:keys [out err exit]} (-> request
+ :results :localhost :configure2 first)]
+ (is out)
+ (is (= err ""))
+ (is (zero? exit)))))
+ (testing "parallel"
+ (let [compute (compute/compute-service "node-list" :node-list [localhost])
+ request (lift {node localhost}
+ :phase [:configure :configure2]
+ :compute compute
+ :environment
+ {:algorithms {:lift-fn parallel-lift}})]
+ (is (map? request))
+ (is (map? (-> request :results)))
+ (is (map? (-> request :results first second)))
+ (is (-> request :results :localhost :configure))
+ (is (-> request :results :localhost :configure2))
+ (let [{:keys [out err exit]} (-> request
+ :results :localhost :configure2 first)]
+ (is out)
+ (is (= err ""))
+ (is (zero? exit)))))))
+
+
+(resource/deflocal dummy-local-resource
+ (dummy-local-resource* [request arg] request))
+
+(deftest lift-with-delayed-argument-test
+ ;; test that delayed arguments correcly see parameter updates
+ ;; within the same phase
+ (let [add-slave (fn [request]
+ (let [target-node (:target-node request)
+ target-ip (compute/primary-ip target-node)]
+ (parameter/update-for-service
+ request
+ [:slaves]
+ (fn [v] (conj (or v []) target-ip)))))
+ seen (atom false)
+ get-slaves (fn [request]
+ (reset! seen true)
+ (is (= ["127.0.0.1" "127.0.0.1"]
+ (parameter/get-for-service request [:slaves]))))
+
+ master (make-node "master" {}
+ :configure (fn [request]
+ (dummy-local-resource
+ request
+ (argument/delayed
+ [request]
+ (get-slaves request)))))
+ slave (make-node "slave" {} :configure add-slave)
+ slaves [(test-utils/make-localhost-node :name "a" :id "a" :tag "slave")
+ (test-utils/make-localhost-node :name "b" :id "b" :tag "slave")]
+ master-node (test-utils/make-localhost-node :name "c" :tag "master")
+ compute (compute/compute-service
+ "node-list" :node-list (conj slaves master-node))]
+ (testing "serial"
+ (let [request (lift
+ [master slave]
+ :compute compute
+ :environment {:algorithms {:lift-fn sequential-lift}})]
+ (is @seen "get-slaves should be called")
+ (is (= ["127.0.0.1" "127.0.0.1"]
+ (parameter/get-for-service request [:slaves]))))
+ (testing "node sequence neutrality"
+ (let [request (lift
+ [slave master]
+ :compute compute
+ :environment {:algorithms {:lift-fn sequential-lift}})]
+ (is @seen "get-slaves should be called")
+ (is (= ["127.0.0.1" "127.0.0.1"]
+ (parameter/get-for-service request [:slaves]))))))
+ (testing "parallel"
+ (let [request (lift
+ [master slave]
+ :compute compute
+ :environment {:algorithms {:lift-fn parallel-lift}})]
+ (is @seen "get-slaves should be called")
+ (is (= ["127.0.0.1" "127.0.0.1"]
+ (parameter/get-for-service request [:slaves])))))))
+
+(resource/deflocal checking-set
+ (checking-set*
+ [request]
+ (is (= ["127.0.0.1" "127.0.0.1"]
+ (parameter/get-for-service request [:slaves])))
+ request))
+
+(deftest lift-post-phase-test
+ (testing
+ "test that parameter updates are correctly seen in the post phase"
+ (let [add-slave (fn [request]
+ (let [target-node (:target-node request)
+ target-ip (compute/primary-ip target-node)]
+ (parameter/update-for-service
+ request
+ [:slaves]
+ (fn [v] (conj (or v []) target-ip)))))
+ slave (make-node "slave" {} :configure add-slave)
+ slaves [(test-utils/make-localhost-node
+ :name "a" :id "a" :tag "slave")
+ (test-utils/make-localhost-node
+ :name "b" :id "b" :tag "slave")]
+ master-node (test-utils/make-localhost-node
+ :name "c" :id "c" :tag "master")
+ compute (compute/compute-service
+ "node-list" :node-list (conj slaves master-node))]
+ (testing "with serial lift"
+ (let [[localf-pre seen-pre?] (seen-fn "lift-post-phase-test pre")
+ [localf-post seen-post?] (seen-fn "lift-post-phase-test post")
+ master (make-node "master" {}
+ :configure (resource/phase
+ (resource/execute-pre-phase
+ checking-set
+ localf-pre)
+ (resource/execute-after-phase
+ checking-set
+ localf-post)))
+
+ request (lift
+ [master slave]
+ :compute compute
+ :environment {:algorithms {:lift-fn sequential-lift}})]
+ (is (seen-pre?) "checking-not-set should be called")
+ (is (seen-post?) "checking-set should be called")
+ (is (= ["127.0.0.1" "127.0.0.1"]
+ (parameter/get-for-service request [:slaves])))))
+ (testing "with serial lift in reverse node type order"
+ (let [[localf-pre seen-pre?] (seen-fn "lift-post-phase-test pre")
+ [localf-post seen-post?] (seen-fn "lift-post-phase-test post")
+ master (make-node "master" {}
+ :configure (resource/phase
+ (resource/execute-pre-phase
+ checking-set
+ localf-pre)
+ (resource/execute-after-phase
+ checking-set
+ localf-post)))
+
+ request (lift
+ [slave master]
+ :compute compute
+ :environment {:algorithms {:lift-fn sequential-lift}})]
+ (is (seen-pre?) "checking-not-set should be called")
+ (is (seen-post?) "checking-set should be called")
+ (is (= ["127.0.0.1" "127.0.0.1"]
+ (parameter/get-for-service request [:slaves])))))
+ (testing "with parallel lift"
+ (let [[localf-pre seen-pre?] (seen-fn "lift-post-phase-test pre")
+ [localf-post seen-post?] (seen-fn "lift-post-phase-test post")
+ master (make-node "master" {}
+ :configure (resource/phase
+ (resource/execute-pre-phase
+ checking-set
+ localf-pre)
+ (resource/execute-after-phase
+ checking-set
+ localf-post)))
+
+ request (lift
+ [master slave]
+ :compute compute
+ :environment {:algorithms {:lift-fn parallel-lift}})]
+ (is (seen-pre?) "checking-not-set should be called")
+ (is (seen-post?) "checking-set should be called")
+ (is (= ["127.0.0.1" "127.0.0.1"]
+ (parameter/get-for-service request [:slaves]))))))))
View
5 test/pallet/resource_test.clj
@@ -29,10 +29,7 @@
(deftest phase-list-test
(testing "pre, after added"
(is (= [:pre-fred :fred :after-fred]
- (phase-list [:fred]))))
- (testing "configure as default"
- (is (= [:pre-configure :configure :after-configure]
- (phase-list [])))))
+ (phase-list :fred)))))
(defmacro is-phase
[request phase]

0 comments on commit 8342743

Please sign in to comment.
Something went wrong with that request. Please try again.