git.fiddlerwoaroof.com
Browse code

(init)

Ed L authored on 29/05/2020 16:22:02
Showing 5 changed files
.gitignore
History View file @ 4b0ba60
1 1 
new file mode 100644
... ... 
@@ -0,0 +1,14 @@
1 
+/target
2 
+/classes
3 
+/checkouts
4 
+*.jar
5 
+*.class
6 
+/.cpcache
7 
+/.lein-*
8 
+/.nrepl-history
9 
+/.nrepl-port
10 
+.hgignore
11 
+.hg/
12 
+*~
13 
+[#]*
14 
+.[#]*
deps.edn
History View file @ 4b0ba60
0 15 
new file mode 100644
... ... 
@@ -0,0 +1,16 @@
1 
+{:paths ["src" "resources"]
2 
+ :java-opts ["--add-modules=java.management"]
3 
+ :deps {org.clojure/clojure {:mvn/version "1.10.1"}
4 
+        org.clojure/java.jmx {:mvn/version "1.0.0"}}
5 
+ :aliases
6 
+ {:test {:extra-paths ["test"]
7 
+         :extra-deps {org.clojure/test.check {:mvn/version "1.0.0"}}}
8 
+  :runner
9 
+  {:extra-deps {com.cognitect/test-runner
10 
+                {:git/url "https://github.com/cognitect-labs/test-runner"
11 
+                 :sha "f7ef16dc3b8332b0d77bc0274578ad5270fbfedd"}}
12 
+   :main-opts ["-m" "cognitect.test-runner"
13 
+               "-d" "test"]}
14 
+  :uberjar {:extra-deps {seancorfield/depstar {:mvn/version "1.0.94"}}
15 
+            :main-opts ["-m" "hf.depstar.uberjar" "jmx-test.jar"
16 
+                        "-C" "-m" "co.fwoar.jmx-test"]}}}
src/co/fwoar/CrazyBean.clj
History View file @ 4b0ba60
0 17 
new file mode 100644
... ... 
@@ -0,0 +1,116 @@
1 
+(ns co.fwoar.CrazyBean
2 
+  (:import [javax.management MBeanInfo AttributeList MBeanAttributeInfo
3 
+            MBeanOperationInfo MBeanParameterInfo])
4 
+  (:require [clojure.string :as str])
5 
+  (:gen-class
6 
+   :implements [javax.management.DynamicMBean]
7 
+   :init init
8 
+   :state state
9 
+   :constructors {[Object] []}))
10 
+
11 
+(def ^{:private true} guess-attribute-map
12 
+  {"java.lang.Integer" "int"
13 
+   "java.lang.Boolean" "boolean"
14 
+   "java.lang.Long" "long"})
15 
+
16 
+(defn- guess-attribute-typename
17 
+  "Guess the attribute typename for MBeanAttributeInfo based on the attribute value."
18 
+  [value]
19 
+  (let [classname (.getName (class value))]
20 
+    (get guess-attribute-map classname classname)))
21 
+
22 
+(defn- build-attribute-info
23 
+  "Construct an MBeanAttributeInfo. Normally called with a key/value pair from a Clojure map."
24 
+  ([attr-name attr-value]
25 
+   (build-attribute-info
26 
+    (name attr-name)
27 
+    (guess-attribute-typename attr-value)
28 
+    (name attr-name) true false false))
29 
+  ([name type desc readable? writable? is?] (MBeanAttributeInfo. name type desc readable? writable? is? )))
30 
+
31 
+(defn- map->attribute-infos
32 
+  "Construct an MBeanAttributeInfo[] from a Clojure associative."
33 
+  [attr-map]
34 
+  (into-array MBeanAttributeInfo
35 
+              (map (fn [[attr-name value]] (build-attribute-info attr-name value))
36 
+                   attr-map)))
37 
+
38 
+;; todo mv to util
39 
+(defn zip [& cols] (apply map vector cols))
40 
+
41 
+(defn unmangle
42 
+  "Given the name of a class that implements a Clojure function, returns the function's name in Clojure. Note: If the true Clojure function name
43 
+  contains any underscores (a rare occurrence), the unmangled name will
44 
+  contain hyphens at those locations instead."
45 
+  [class-name]
46 
+  (.replace (str/replace class-name #"^(.+)\$(.+)__\d+$" "$1/$2")
47 
+            \_ \-))
48 
+
49 
+(defn fn-by-name
50 
+  "lookup string to fn at run time"
51 
+  [ns-symbol fn-name]
52 
+  (intern (clojure.lang.Namespace/find ns-symbol) (symbol (name fn-name))))
53 
+;; /util
54 
+
55 
+(defn -init [derefable]
56 
+  [[] derefable])
57 
+
58 
+(defn build-parameter-info [param opts]
59 
+  (let [{:keys [name type description]
60 
+         :or {name  (.getName param)
61 
+              type  (.getName param)
62 
+              description ""}} opts]
63 
+    (MBeanParameterInfo. name type description)))
64 
+
65 
+(defn parameter-infos [params-seq]
66 
+  (into-array MBeanParameterInfo
67 
+   (map
68 
+    (fn [[i param]]
69 
+      (build-parameter-info param {:name (str "p" i)}))
70 
+    (zip (range 0 (count params-seq)) params-seq))))
71 
+
72 
+(defn build-operation-info [ifn opts]
73 
+  (let [{:keys [name description argv return-type impact]
74 
+         :or {name         (unmangle (.getName (class ifn)))
75 
+              description  (unmangle (.getName (class ifn)))
76 
+              argv         nil
77 
+              return-type  "void"
78 
+              impact       MBeanOperationInfo/ACTION}} opts
79 
+         params (parameter-infos argv)]
80 
+   (MBeanOperationInfo. name description params return-type impact)))
81 
+
82 
+(defn operation-infos [ops-seq]
83 
+  (into-array (map (fn [[ifn opts]] (build-operation-info ifn opts))
84 
+                   ops-seq)))
85 
+
86 
+; TODO: rest of the arguments, as needed
87 
+(defn generate-mbean-info [clj-bean]
88 
+  (MBeanInfo.
89 
+   (.. clj-bean getClass getName)                     ; class name
90 
+   "Clojure Dynamic MBean"                            ; description
91 
+   (map->attribute-infos (dissoc @(.state clj-bean)   ; attributes
92 
+                                 :operations))
93 
+   nil                                                ; constructors
94 
+   (operation-infos (@(.state clj-bean) :operations)) ; operations
95 
+   nil))                                              ; notifications
96 
+(defn -getMBeanInfo
97 
+  [this]
98 
+  (generate-mbean-info this))
99 
+
100 
+(defn -getAttribute
101 
+  [this attr]
102 
+  (@(.state this) (keyword attr)))
103 
+
104 
+(defn -getAttributes
105 
+  [this attrs]
106 
+  (let [result (AttributeList.)]
107 
+    (doseq [attr attrs]
108 
+      (.add result (.getAttribute this attr)))
109 
+    result))
110 
+
111 
+(defn -invoke [this name args sig]
112 
+  ;; this might be a huge security hole fyi
113 
+  ;; who knows what kind of havoc this could wreak!
114 
+  (let [[ns-name fn-name] (str/split name #"\$")
115 
+        ifn (fn-by-name (symbol ns-name) fn-name)]
116 
+    (apply ifn (seq args))))
src/co/fwoar/bean.clj
History View file @ 4b0ba60
0 117 
new file mode 100644
... ... 
@@ -0,0 +1,107 @@
1 
+(ns co.fwoar.bean
2 
+  (:import [javax.management DynamicMBean MBeanInfo AttributeList MBeanAttributeInfo
3 
+            MBeanOperationInfo MBeanParameterInfo])
4 
+  (:require [clojure.string :as str]))
5 
+
6 
+(defn- build-attribute-info
7 
+  "Construct an MBeanAttributeInfo. Normally called with a key/value pair from a Clojure map."
8 
+  ([attr-name attr-value desc readable? writable? is?]
9 
+   (MBeanAttributeInfo. (name attr-name)
10 
+                        attr-value
11 
+                        (name desc)
12 
+                        readable? writable? is? )))
13 
+
14 
+(defn- map->attribute-infos
15 
+  "Construct an MBeanAttributeInfo[] from a Clojure associative."
16 
+  [attr-map]
17 
+  (into-array MBeanAttributeInfo
18 
+              (map (fn [[attr-name {:keys [type write?]}]]
19 
+                     (build-attribute-info attr-name type attr-name true write? false))
20 
+                   attr-map)))
21 
+
22 
+;; todo mv to util
23 
+
24 
+(defn unmangle
25 
+  "Given the name of a class that implements a Clojure function, returns the function's name in Clojure. Note: If the true Clojure function name
26 
+  contains any underscores (a rare occurrence), the unmangled name will
27 
+  contain hyphens at those locations instead."
28 
+  [class-name]
29 
+  (.replace (str/replace class-name #"^(.+)\$(.+)__\d+$" "$1/$2")
30 
+            \_ \-))
31 
+
32 
+(defn fn-by-name
33 
+  "lookup string to fn at run time"
34 
+  [ns-symbol fn-name]
35 
+  (intern (clojure.lang.Namespace/find ns-symbol) (symbol (name fn-name))))
36 
+;; /util
37 
+
38 
+(defn -init [derefable]
39 
+  [[] derefable])
40 
+
41 
+(defn build-parameter-info [param opts]
42 
+  (let [{:keys [name type description]
43 
+         :or {name  (.getName param)
44 
+              type  (.getName param)
45 
+              description ""}} opts]
46 
+    (MBeanParameterInfo. name type description)))
47 
+
48 
+(defn parameter-infos [params-seq]
49 
+  (->> (sequence (map (fn [i param]
50 
+                        (build-parameter-info param {:name (str "p" i)})))
51 
+                 (iterate inc 0)
52 
+                 params-seq)
53 
+       (into-array MBeanParameterInfo)))
54 
+
55 
+(defn build-operation-info [ifn opts]
56 
+  (let [{:keys [name description argv return-type impact]
57 
+         :or {name         (unmangle (.getName (class ifn)))
58 
+              description  (unmangle (.getName (class ifn)))
59 
+              argv         nil
60 
+              return-type  "void"
61 
+              impact       MBeanOperationInfo/ACTION}} opts
62 
+        params (parameter-infos argv)]
63 
+    (MBeanOperationInfo. name description params return-type impact)))
64 
+
65 
+(defn operation-infos [ops-seq]
66 
+  (into-array MBeanOperationInfo
67 
+              (map (fn [[ifn opts]] (build-operation-info ifn opts))
68 
+                   ops-seq)))
69 
+
70 
+; TODO: rest of the arguments, as needed
71 
+(defn generate-mbean-info [state clj-bean]
72 
+  (MBeanInfo.
73 
+   (.. clj-bean getClass getName)        ; class name
74 
+   "Clojure Dynamic MBean"               ; description
75 
+   (map->attribute-infos (dissoc state   ; attributes
76 
+                                 :operations))
77 
+   nil                                   ; constructors
78 
+   (operation-infos (state :operations)) ; operations
79 
+   nil))                                 ; notifications
80 
+
81 
+(defn handle-set [state {:keys [name value] :as at}]
82 
+  (println at)
83 
+  (swap! state assoc-in [(keyword name) :value] value))
84 
+
85 
+(deftype MaBean [state]
86 
+  DynamicMBean
87 
+  (getMBeanInfo [this]
88 
+    (generate-mbean-info @state this))
89 
+
90 
+  (getAttribute [this attr]
91 
+    (:value (@state (keyword attr))))
92 
+
93 
+  (getAttributes [this attrs]
94 
+    (let [result (AttributeList.)]
95 
+      (doseq [attr attrs]
96 
+        (.add result (.getAttribute this attr)))
97 
+      result))
98 
+
99 
+  (setAttribute [this attribute]
100 
+    (handle-set state (bean attribute)))
101 
+
102 
+  (invoke [_ name args _]
103 
+    ;; this might be a huge security hole fyi
104 
+    ;; who knows what kind of havoc this could wreak!
105 
+    (let [[ns-name fn-name] (str/split name #"\$")
106 
+          ifn (fn-by-name (symbol ns-name) fn-name)]
107 
+      (apply ifn (seq args)))))
src/co/fwoar/jmx_test.clj
History View file @ 4b0ba60
0 108 
new file mode 100644
... ... 
@@ -0,0 +1,7 @@
1 
+(ns co.fwoar.jmx-test
2 
+  (:gen-class))
3 
+
4 
+(defn -main
5 
+  "I don't do a whole lot ... yet."
6 
+  [& args]
7 
+  (println "Hello, World!"))