git.fiddlerwoaroof.com
Raw Blame History
(ns co.fwoar.bean
  (:import [javax.management DynamicMBean MBeanInfo AttributeList MBeanAttributeInfo
            MBeanOperationInfo MBeanParameterInfo])
  (:require [clojure.string :as str]))

(defn- build-attribute-info
  "Construct an MBeanAttributeInfo. Normally called with a key/value pair from a Clojure map."
  ([attr-name attr-value desc readable? writable? is?]
   (MBeanAttributeInfo. (name attr-name)
                        attr-value
                        (name desc)
                        readable? writable? is? )))

(defn- map->attribute-infos
  "Construct an MBeanAttributeInfo[] from a Clojure associative."
  [attr-map]
  (into-array MBeanAttributeInfo
              (map (fn [[attr-name {:keys [type write?]}]]
                     (build-attribute-info attr-name type attr-name true write? false))
                   attr-map)))

;; todo mv to util

(defn unmangle
  "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
  contains any underscores (a rare occurrence), the unmangled name will
  contain hyphens at those locations instead."
  [class-name]
  (.replace (str/replace class-name #"^(.+)\$(.+)__\d+$" "$1/$2")
            \_ \-))

(defn fn-by-name
  "lookup string to fn at run time"
  [ns-symbol fn-name]
  (intern (clojure.lang.Namespace/find ns-symbol) (symbol (name fn-name))))
;; /util

(defn -init [derefable]
  [[] derefable])

(defn build-parameter-info [param opts]
  (let [{:keys [name type description]
         :or {name  (.getName param)
              type  (.getName param)
              description ""}} opts]
    (MBeanParameterInfo. name type description)))

(defn parameter-infos [params-seq]
  (->> (sequence (map (fn [i param]
                        (build-parameter-info param {:name (str "p" i)})))
                 (iterate inc 0)
                 params-seq)
       (into-array MBeanParameterInfo)))

(defn build-operation-info [ifn opts]
  (let [{:keys [name description argv return-type impact]
         :or {name         (unmangle (.getName (class ifn)))
              description  (unmangle (.getName (class ifn)))
              argv         nil
              return-type  "void"
              impact       MBeanOperationInfo/ACTION}} opts
        params (parameter-infos argv)]
    (MBeanOperationInfo. name description params return-type impact)))

(defn operation-infos [ops-seq]
  (into-array MBeanOperationInfo
              (map (fn [[ifn opts]] (build-operation-info ifn opts))
                   ops-seq)))

; TODO: rest of the arguments, as needed
(defn generate-mbean-info [state clj-bean]
  (MBeanInfo.
   (.. clj-bean getClass getName)        ; class name
   "Clojure Dynamic MBean"               ; description
   (map->attribute-infos (dissoc state   ; attributes
                                 :operations))
   nil                                   ; constructors
   (operation-infos (state :operations)) ; operations
   nil))                                 ; notifications

(defn handle-set [state {:keys [name value] :as at}]
  (println at)
  (swap! state assoc-in [(keyword name) :value] value))

(deftype MaBean [state]
  DynamicMBean
  (getMBeanInfo [this]
    (generate-mbean-info @state this))

  (getAttribute [this attr]
    (:value (@state (keyword attr))))

  (getAttributes [this attrs]
    (let [result (AttributeList.)]
      (doseq [attr attrs]
        (.add result (.getAttribute this attr)))
      result))

  (setAttribute [this attribute]
    (handle-set state (bean attribute)))

  (invoke [_ name args _]
    ;; this might be a huge security hole fyi
    ;; who knows what kind of havoc this could wreak!
    (let [[ns-name fn-name] (str/split name #"\$")
          ifn (fn-by-name (symbol ns-name) fn-name)]
      (apply ifn (seq args)))))