(ns co.fwoar.CrazyBean (:import [javax.management MBeanInfo AttributeList MBeanAttributeInfo MBeanOperationInfo MBeanParameterInfo]) (:require [clojure.string :as str]) (:gen-class :implements [javax.management.DynamicMBean] :init init :state state :constructors {[Object] []})) (def ^{:private true} guess-attribute-map {"java.lang.Integer" "int" "java.lang.Boolean" "boolean" "java.lang.Long" "long"}) (defn- guess-attribute-typename "Guess the attribute typename for MBeanAttributeInfo based on the attribute value." [value] (let [classname (.getName (class value))] (get guess-attribute-map classname classname))) (defn- build-attribute-info "Construct an MBeanAttributeInfo. Normally called with a key/value pair from a Clojure map." ([attr-name attr-value] (build-attribute-info (name attr-name) (guess-attribute-typename attr-value) (name attr-name) true false false)) ([name type desc readable? writable? is?] (MBeanAttributeInfo. name type desc readable? writable? is? ))) (defn- map->attribute-infos "Construct an MBeanAttributeInfo[] from a Clojure associative." [attr-map] (into-array MBeanAttributeInfo (map (fn [[attr-name value]] (build-attribute-info attr-name value)) attr-map))) ;; todo mv to util (defn zip [& cols] (apply map vector cols)) (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] (into-array MBeanParameterInfo (map (fn [[i param]] (build-parameter-info param {:name (str "p" i)})) (zip (range 0 (count params-seq)) params-seq)))) (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 (map (fn [[ifn opts]] (build-operation-info ifn opts)) ops-seq))) ; TODO: rest of the arguments, as needed (defn generate-mbean-info [clj-bean] (MBeanInfo. (.. clj-bean getClass getName) ; class name "Clojure Dynamic MBean" ; description (map->attribute-infos (dissoc @(.state clj-bean) ; attributes :operations)) nil ; constructors (operation-infos (@(.state clj-bean) :operations)) ; operations nil)) ; notifications (defn -getMBeanInfo [this] (generate-mbean-info this)) (defn -getAttribute [this attr] (@(.state this) (keyword attr))) (defn -getAttributes [this attrs] (let [result (AttributeList.)] (doseq [attr attrs] (.add result (.getAttribute this attr))) result)) (defn -invoke [this name args sig] ;; 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))))