info.voidstar/tbnl.figurehead

0.1.1-SNAPSHOT


figurehead sits on device and is controlled by mastermind

dependencies

org.clojure-android/clojure
1.6.0-RC1
org.clojars.pw4ever/neko-sdk18
3.0.3
info.voidstar/tbnl.core
0.1.1-SNAPSHOT
org.clojure/core.async
0.1.303.0-886421-alpha
org.clojure/tools.nrepl
0.2.4
cider/cider-nrepl
0.7.0
commons-io/commons-io
2.4
compliment
0.1.3



(this space intentionally left almost blank)
 
(ns figurehead.api.app.activity-controller
  (:require (figurehead.util [services :as services :refer [get-service]]))
  (:require [clojure.string :as str]
            [clojure.java.io :as io])
  (:import (android.app IActivityManager
                        IActivityController$Stub)
           (android.content Intent)))
(declare set-activity-controller)

set ActivityController

(defn set-activity-controller
  [{:keys [reset?
           activity-controller
           activity-starting
           activity-resuming
           app-crashed
           app-early-not-responding
           app-not-responding
           system-not-responding]
    :as args}]
  (let [activity-manager ^IActivityManager (get-service :activity-manager)
        activity-controller (cond reset? nil
                                  activity-controller activity-controller
                                  :else
                                  (proxy
                                      [IActivityController$Stub]
                                      []
                                    (activityStarting [^Intent intent package]
                                      (locking this
                                        (if activity-starting
                                          (activity-starting intent package)
                                          true)))
                                    (activityResuming [package]
                                      (locking this
                                        (if activity-resuming
                                          (activity-resuming package)
                                          true)))
                                    (appCrashed [process-name pid
                                                 short-msg long-msg
                                                 time-millis stack-trace]
                                      (locking this
                                        (if app-crashed
                                          (app-crashed process-name pid
                                                       short-msg long-msg
                                                       time-millis stack-trace)
                                          true)))
                                    (appEarlyNotResponding [process-name pid annotation]
                                      (locking this
                                        (if app-early-not-responding
                                          (app-early-not-responding process-name pid annotation)
                                          1)))
                                    (appNotResponding [process-name pid process-stats]
                                      (locking this
                                        (if app-not-responding
                                          (app-not-responding process-name pid process-stats)
                                          1)))
                                    (systemNotResponding [msg]
                                      (locking this
                                        (if system-not-responding
                                          (system-not-responding msg)
                                          1)))))]
    (.setActivityController activity-manager
                            activity-controller)))
 

am (Activity Manager) wrapper

(ns figurehead.api.app.activity-manager
  (:require (core [state :as state :refer [defcommand]]))
  (:require (figurehead.util [services :as services :refer [get-service]])
            (figurehead.api.content [intent :as intent]))
  (:require [clojure.string :as str]
            [clojure.java.io :as io])
  (:import (android.app IActivityManager
                        AppOpsManager)
           (android.content Intent
                            IIntentReceiver$Stub
                            ComponentName)
           (android.net Uri)
           (android.os Bundle
                       Binder)))
(declare start-activity start-service
         force-stop kill kill-all
         send-broadcast
         hang
         intent-to-uri)

start an Activity (accept all figurehead.api.content.intent/make-intent arguments)

(defcommand start-activity
  [{:keys [wait?]
    :as args}]
  (let [intent ^Intent (intent/make-intent args)
        activity-manager ^IActivityManager (get-service :activity-manager)
        mime-type (atom nil)]
    (when intent
      (reset! mime-type (.getType intent))
      (when (and (not @mime-type)
                 (.getData intent)
                 (= (.. intent getData getScheme) "content"))
        (reset! mime-type (.getProviderMimeType activity-manager
                                                (.getData intent)
                                                0)))
      (if wait?
        (.. activity-manager
            ^IactivityManager$WaitResult (startActivityAndWait nil nil ^Intent intent ^String @mime-type
                                                               nil nil 0 0
                                                               nil nil nil 0)
            result)
        (.. activity-manager
            (startActivityAsUser nil nil ^Intent intent ^String @mime-type
                                 nil nil 0 0
                                 nil nil nil 0))))))

start Service (accept all figurehead.api.content.intent/make-intent arguments)

(defcommand start-service
  [{:keys []
    :as args}]
  (let [intent ^Intent (intent/make-intent args)
        activity-manager ^IActivityManager (get-service :activity-manager)]
    (when intent
      (.. activity-manager
          ^ComponentName (startService nil intent (.getType intent) 0)))))

force stop a Package

(defcommand force-stop
  [{:keys [package]
    :as args}]
  (let [activity-manager ^IActivityManager (get-service :activity-manager)]
    (.forceStopPackage activity-manager package 0)))

kill a Package

(defcommand kill
  [{:keys [package]
    :as args}]
  (let [activity-manager ^IActivityManager (get-service :activity-manager)]
    (.killBackgroundProcesses activity-manager package 0)))

kill all Packages

(defcommand kill-all
  [{:keys []
    :as args}]
  (let [activity-manager ^IActivityManager (get-service :activity-manager)]
    (.killAllBackgroundProcesses activity-manager)))

send broadcast

(defcommand send-broadcast
  [{:keys [perform-receive
           receiver-permission]
    :as args}]
  (let [intent ^Intent (intent/make-intent args)
        activity-manager ^IActivityManager (get-service :activity-manager)
        intent-receiver (proxy
                            [IIntentReceiver$Stub]
                            []
                          (performReceive [^Intent intent result-code ^String data ^Bundle extras
                                           ordered sticky sending-user]
                            (when perform-receive
                              (perform-receive {:intent intent :result-code result-code
                                                :data data :extras extras
                                                :ordered ordered :sticky sticky
                                                :sending-user sending-user}))))]
    (when (and intent intent-receiver)
      (.broadcastIntent activity-manager
                        nil intent nil intent-receiver
                        0 nil nil receiver-permission
                        AppOpsManager/OP_NONE true false 0))))

hang

(defcommand hang
  [{:keys [allow-restart]
    :as args}]
  (let [activity-manager ^IActivityManager (get-service :activity-manager)]
    (.hang activity-manager (Binder.) allow-restart)))

convert intent to URI

(defcommand intent-to-uri
  [{:keys [intent-scheme?]
    :as args}]
  (let [intent ^Intent (intent/make-intent args)]
    (when (and intent)
      (.toUri intent (if intent-scheme?
                       Intent/URI_INTENT_SCHEME
                       0)))))
 

create android.content.Intent

https://github.com/android/platformframeworksbase/blob/android-4.3_r3.1/cmds/am/src/com/android/commands/am/Am.java#L479

(ns figurehead.api.content.intent
  (:require (core [state :as state :refer [defcommand]]))
  (:import (android.content Intent
                            ComponentName)
           (android.os Bundle)
           (android.net Uri)))
(declare make-intent)

make an Intent object

(defcommand make-intent
  [{:keys [action
           categories
           extras
           package
           component
           flags
           ^Uri data
           type
           wild-card
           ]
    :as args}]
  (let [intent (Intent.)]
    ;; action
    (when action
      (.setAction ^Intent intent action))
    ;; a seq of categories
    (when categories
      (doseq [category categories]
        (.addCategory ^Intent intent category)))
    ;; a seq of extras
    (when extras
      (doseq [[key val] extras]
        (.putExtra ^Intent intent key val)))
    ;; package
    (when package
      (.setPackage ^Intent intent package))
    ;; component
    (when component
      (.setComponent ^Intent intent
                     (ComponentName/unflattenFromString component)))
    ;; flags can be either a number or a seq of individual flags (Intent/FLAG_*)
    (when flags
      (cond (number? flags)
            (.setFlags ^Intent intent
                       flags)
            (seq? flags)
            (doseq [flag flags]
              (.addFlags ^Intent intent flag))))
    ;; data and type
    (.setDataAndType ^Intent intent data type)
    ;; free-form wild-card
    (when wild-card
      (let [wild-card (str wild-card)]
        (cond (>= (.indexOf wild-card ":") 0)
              (do
                ;; wild-card is a URI; fully parse it
                (.setData intent (Intent/parseUri wild-card Intent/URI_INTENT_SCHEME)))
              (>= (.indexOf wild-card "/") 0)
              (do
                ;; wild-card is a component name; build an intent to launch it
                (.setAction ^Intent intent Intent/ACTION_MAIN)
                (.addCategory ^Intent intent Intent/CATEGORY_LAUNCHER)
                (.setComponent ^Intent intent (ComponentName/unflattenFromString wild-card)))
              :else
              (do
                ;; assume wild-card is a package name
                (.setAction ^Intent intent Intent/ACTION_MAIN)
                (.addCategory ^Intent intent Intent/CATEGORY_LAUNCHER)
                (.setPackage ^Intent intent wild-card)))))
    intent))
 

pm (Package Manager) wrapper

https://github.com/android/platformframeworksbase/blob/android-4.3_r3.1/cmds/pm/src/com/android/commands/pm/Pm.java

(ns figurehead.api.content.pm.package-manager
  (:require (core [state :as state :refer [defcommand]]))  
  (:require (figurehead.util [services :as services :refer [get-service]]))
  (:require [figurehead.api.content.pm.package-manager-parser :as parser]
            [figurehead.api.util.file :as util-file])
  (:require [clojure.string :as str]
            [clojure.java.io :as io])  
  (:import (android.app IActivityManager)
           (android.content ComponentName)
           (android.content.pm ActivityInfo
                               ApplicationInfo
                               ContainerEncryptionParams
                               FeatureInfo
                               IPackageDataObserver
                               IPackageDataObserver$Stub
                               IPackageDeleteObserver
                               IPackageDeleteObserver$Stub
                               IPackageInstallObserver
                               IPackageInstallObserver$Stub
                               IPackageManager
                               InstrumentationInfo
                               PackageInfo
                               PackageItemInfo
                               PackageManager
                               ParceledListSlice
                               PermissionGroupInfo
                               PermissionInfo
                               ProviderInfo
                               ServiceInfo
                               UserInfo
                               VerificationParams)
           (android.content.res AssetManager
                                Resources)
           (android.net Uri)
           (android.os IUserManager
                       RemoteException
                       ServiceManager
                       UserHandle
                       UserManager)
           (android.util Base64)
           (com.android.internal.content PackageHelper)
           (java.io File)
           (javax.crypto SecretKey)
           (javax.crypto.spec IvParameterSpec
                              SecretKeySpec)
           (org.apache.commons.io FileUtils)))
(declare get-raw-packages get-packages get-all-package-names get-package-components
         get-raw-features get-features
         get-raw-libraries get-libraries
         get-raw-instrumentations get-instrumentations
         get-raw-permission-groups get-permissions-by-group

         get-install-location set-install-location
         push-file pull-file
         make-package-install-observer install-package
         make-package-delete-observer uninstall-package
         make-package-data-observer clear-package-data)

get all packages on this device

(defcommand get-raw-packages
  [{:keys []
    :as args}]
  (let [^IPackageManager package-manager (get-service :package-manager)]
    (let [packages  (.. package-manager
                        (getInstalledPackages
                         (bit-or PackageManager/GET_ACTIVITIES
                                 PackageManager/GET_CONFIGURATIONS
                                 PackageManager/GET_DISABLED_COMPONENTS
                                 PackageManager/GET_DISABLED_UNTIL_USED_COMPONENTS
                                 PackageManager/GET_GIDS
                                 PackageManager/GET_INSTRUMENTATION
                                 PackageManager/GET_INTENT_FILTERS
                                 PackageManager/GET_PERMISSIONS
                                 PackageManager/GET_PROVIDERS
                                 PackageManager/GET_RECEIVERS
                                 PackageManager/GET_SERVICES
                                 PackageManager/GET_SIGNATURES)
                         0)
                        getList)]
      (seq packages))))

get all packages on this device

(defcommand get-packages
  [{:keys [brief?]
    :as args}]
  (let [packages (get-raw-packages {})
        result (atom {})]
    (doseq [^PackageInfo package packages]
      (let [package (parser/parse-package-info package)]
        (swap! result assoc
               (keyword (:package-name package))
               (when-not brief?
                 package))))
    @result))

get list of package names

(defcommand get-all-package-names
  [{:keys []
    :as args}]
  (let [packages (get-raw-packages {})
        result (atom #{})]
    (doseq [^PackageInfo package packages]
      (swap! result conj
             (keyword (.packageName package))))
    @result))

get app components for a specific package

(defcommand get-package-components
  [{:keys [package]
    :as args}]
  (when package
    (let [package-manager ^IPackageManager (get-service :package-manager)]
      (when-let [pkg-info (.getPackageInfo package-manager
                                           (cond
                                             (keyword? package)
                                             (name package)
                                             (sequential? package)
                                             (str/join "."
                                                       (map #(cond (keyword? %) (name %)
                                                                   :else (str %))
                                                            package))
                                             :else
                                             (str package))
                                           (bit-or PackageManager/GET_ACTIVITIES
                                                   PackageManager/GET_PROVIDERS
                                                   PackageManager/GET_RECEIVERS
                                                   PackageManager/GET_SERVICES
                                                   PackageManager/GET_PERMISSIONS)
                                           0)]
        {:activities (set (for [^ActivityInfo activity (.activities pkg-info)]
                            (keyword (.name activity))))
         :services (set (for [^ServiceInfo service (.services pkg-info)]
                          (keyword (.name service))))
         :providers (set (for [^ProviderInfo provider (.providers pkg-info)]
                           (keyword (.name provider))))
         :receivers (set (for [^ActivityInfo receiver (.receivers pkg-info)]
                           (keyword (.name receiver))))
         :permissions (set (for [^PermissionInfo permission (.permissions pkg-info)]
                             (keyword (.name permission))))}))))

get all features on this device

(defcommand get-raw-features
  [{:keys []
    :as args}]
  (let [^IPackageManager package-manager (get-service :package-manager)]
    (let [features  (.. package-manager
                        getSystemAvailableFeatures)]
      (seq features))))

get all features on this device

(defcommand get-features
  [{:keys [brief?]
    :as args}]
  (let [features (get-raw-features {})
        result (atom {})]
    (doseq [^FeatureInfo feature features]
      (let [feature (parser/parse-feature-info feature)]
        (swap! result assoc
               (keyword (:name feature))
               (when-not brief?
                 feature))))
    @result))

get all libraries on this device

(defcommand get-raw-libraries
  [{:keys []
    :as args}]
  (let [^IPackageManager package-manager (get-service :package-manager)]
    (let [libraries  (.. package-manager
                        getSystemSharedLibraryNames)]
      (seq libraries))))

get all libraries on this device

(defcommand get-libraries
  [{:keys []
    :as args}]
  (let [libraries (get-raw-libraries {})
        result (atom [])]
    (doseq [^String library libraries]
      (swap! result conj
             library))
    @result))

get installed instrumentations on this device, optional for a specific package

(defcommand get-raw-instrumentations
  [{:keys [^String package]
    :as args}]
  (let [^IPackageManager package-manager (get-service :package-manager)]
    (let [instrumentations  (.. package-manager
                                (queryInstrumentation package 0))]
      (seq instrumentations))))

get installed instrumentations on this device, optional for a specific package

(defcommand get-instrumentations
  [{:keys [^String package
           brief?]
    :as args}]
  (let [instrumentations (get-raw-instrumentations {:package package})
        result (atom {})]
    (doseq [^InstrumentationInfo instrumentation instrumentations]
      (let [instrumentation (parser/parse-instrumentation-info instrumentation)]
        (swap! result assoc
               (keyword (:name instrumentation))
               (when-not brief?
                 instrumentation))))
    @result))

get permission groups

(defcommand get-raw-permission-groups
  [{:keys []
    :as args}]
  (let [^IPackageManager package-manager (get-service :package-manager)]
    (let [permission-groups (.. package-manager
                                (getAllPermissionGroups 0))]
      (seq permission-groups))))

get all permissions by group

(defcommand get-permissions-by-group
  [{:keys [brief?]
    :as args}]
  (let [permission-groups (get-raw-permission-groups {})
        result (atom {})]
    (doseq [^PermissionGroupInfo permission-group permission-groups]
      (let [permission-group (parser/parse-permission-group-info permission-group)]
        (swap! result assoc
               (keyword (:name permission-group))
               (merge {}
                      (when-not brief?
                        permission-group)
                      {:permissions
                       (let [^IPackageManager package-manager (get-service :package-manager)
                             result (atom {})]
                         (doseq [^PermissionInfo permission
                                 (.queryPermissionsByGroup package-manager
                                                           (:name permission-group)
                                                           0)]
                           (let [permission (parser/parse-permission-info permission)]
                             (swap! result assoc
                                    (keyword (:name permission))
                                    (when-not brief?
                                      permission))))
                         @result)}))))
    @result))

get install location

(defcommand get-install-location
  [{:keys []
    :as args}]
  (let [^IPackageManager package-manager (get-service :package-manager)
        location (.getInstallLocation package-manager)]
    (cond
     (= location PackageHelper/APP_INSTALL_AUTO) :auto
     (= location PackageHelper/APP_INSTALL_EXTERNAL) :external
     (= location PackageHelper/APP_INSTALL_INTERNAL) :internal
     :else location)))

set install location

(defcommand set-install-location
  [{:keys [location]
    :or {location 0}
    :as args}]
  {:pre [(contains? #{PackageHelper/APP_INSTALL_AUTO
                      PackageHelper/APP_INSTALL_EXTERNAL
                      PackageHelper/APP_INSTALL_INTERNAL
                      :auto :internal :external} location)]}
  (let [location (cond
                  (contains? #{PackageHelper/APP_INSTALL_AUTO
                               PackageHelper/APP_INSTALL_EXTERNAL
                               PackageHelper/APP_INSTALL_INTERNAL}
                             location)
                  location
                  (contains? #{:auto :internal :external} location)
                  ({:auto PackageHelper/APP_INSTALL_AUTO
                    :internal PackageHelper/APP_INSTALL_INTERNAL
                    :external PackageHelper/APP_INSTALL_EXTERNAL} location))]
    (when location
      (let [^IPackageManager package-manager (get-service :package-manager)]
        (.setInstallLocation package-manager location)))))

push Base64-encoded content to device and write to file

(defcommand push-file
  [{:keys [^String content
           file]
    :as args}]
  {:pre [content file]}
  (when (and content file)
    (util-file/write-file {:file file
                           :content content})))

pull file from device and encode to Base64-encoded content

(defcommand pull-file
  [{:keys [file]
    :as args}]
  {:pre [file]}
  (when (and file)
    (util-file/read-file {:file file
                          :content? true})))

make instance of IPackageInstallObserver$Stub

(defcommand make-package-install-observer
  [{:keys [package-installed]
    :as args}]
  (proxy
      [IPackageInstallObserver$Stub]
      []
    (packageInstalled [package-name status]
      (locking this
        (when package-installed
          (package-installed package-name status))))))

install package

(defcommand install-package
  [{:keys [apk-file-name
           package-name
           forward-lock?
           replace-existing?
           allow-test?
           external?
           internal?
           allow-downgrade?]
    :as args}]
  (when (and apk-file-name package-name)
    (let [^IPackageManager package-manager (get-service :package-manager)
          flags (atom 0)
          apk-uri (Uri/fromFile (io/file apk-file-name))]
      (when (and apk-uri)
        (when forward-lock?
          (swap! flags bit-or PackageManager/INSTALL_FORWARD_LOCK))
        (when replace-existing?
          (swap! flags bit-or PackageManager/INSTALL_REPLACE_EXISTING))
        (when allow-test?
          (swap! flags bit-or PackageManager/INSTALL_ALLOW_TEST))
        (when external?
          (swap! flags bit-or PackageManager/INSTALL_EXTERNAL))
        (when internal?
          (swap! flags bit-or PackageManager/INSTALL_INTERNAL))
        (when allow-downgrade?
          (swap! flags bit-or PackageManager/INSTALL_ALLOW_DOWNGRADE))
        (let [finished? (promise)
              result (atom 0)]
          (.installPackage package-manager
                           apk-uri
                           (make-package-install-observer
                            {:package-installed (fn [package-name status]
                                                  (reset! result status)
                                                  (deliver finished? true))})
                           @flags
                           package-name)
          @finished?
          @result)))))

make instance of IPackageDeleteObserver$Stub

(defcommand make-package-delete-observer
  [{:keys [package-deleted]
    :as args}]
  (proxy
      [IPackageDeleteObserver$Stub]
      []
    (packageDeleted [package-name return-code]
      (locking this
        (when package-deleted
          (package-deleted package-name return-code))))))

uninstall package

(defcommand uninstall-package
  [{:keys [package
           keep-data?]
    :or {keep-data? true}
    :as args}]
  (when package
    (let [^IPackageManager package-manager (get-service :package-manager)
          flags (atom PackageManager/DELETE_ALL_USERS)
          finished? (promise)
          successful? (atom false)]
      (when keep-data?
        (swap! flags bit-or PackageManager/DELETE_KEEP_DATA))
      (.deletePackageAsUser package-manager
                            package
                            (make-package-delete-observer
                             {:package-deleted
                              (fn [package-name return-code]
                                (reset! successful?
                                        (= return-code PackageManager/DELETE_SUCCEEDED))
                                (deliver finished? true))})
                            UserHandle/USER_OWNER
                            @flags)
      @finished?
      @successful?)))

make instance of IPackageDataObserver$Stub

(defcommand make-package-data-observer
  [{:keys [on-remove-completed]
    :as args}]
  (proxy
      [IPackageDataObserver$Stub]
      []
    (onRemoveCompleted [package-name succeeded]
      (locking this
        (when on-remove-completed
          (on-remove-completed package-name succeeded))))))

clear package data

(defcommand clear-package-data
  [{:keys [package]
    :as args}]
  (when package
    (let [^IActivityManager activity-manager (get-service :activity-manager)
          finished? (promise)
          successful? (atom false)]
      (.clearApplicationUserData activity-manager
                                 package
                                 (make-package-data-observer
                                  {:on-remove-completed
                                   (fn [package-name succeeded]
                                     (reset! successful?
                                             succeeded)
                                     (deliver finished? true))})
                                 UserHandle/USER_OWNER)
      @finished?
      @successful?)))
 

parse Package Manager objects into Clojure data structures

(ns figurehead.api.content.pm.package-manager-parser
  (:require (figurehead.util [services :as services :refer [get-service]]))
  (:import (android.content ComponentName)
           (android.content.pm ActivityInfo
                               ApplicationInfo
                               ComponentInfo
                               ConfigurationInfo
                               ContainerEncryptionParams
                               FeatureInfo
                               IPackageDataObserver
                               IPackageDeleteObserver
                               IPackageInstallObserver
                               IPackageInstallObserver$Stub
                               IPackageManager
                               InstrumentationInfo
                               PackageInfo
                               PackageItemInfo
                               PackageManager
                               ParceledListSlice
                               PermissionGroupInfo
                               PermissionInfo
                               ProviderInfo
                               ServiceInfo
                               UserInfo
                               VerificationParams)
           (android.content.res AssetManager
                                Resources)
           (android.net Uri)
           (android.os IUserManager
                       RemoteException
                       ServiceManager
                       UserHandle
                       UserManager)
           (android.graphics.drawable Drawable)
           (java.util WeakHashMap)
           (javax.crypto SecretKey)
           (javax.crypto.spec IvParameterSpec
                              SecretKeySpec)))
(declare resource-cache get-resources-by-package-name get-resources
         load-res-string load-res-resource-name load-res-drawable
         parse-package-info

         parse-package-item-info
         parse-component-info

         parse-activity-info
         parse-application-info
         parse-configuration-info
         parse-instrumentation-info
         parse-permission-group-info
         parse-permission-info
         parse-provider-info
         parse-feature-info
         parse-service-info)

resource cache {package-name resources}

(def resource-cache
  (WeakHashMap.))

get resources by package name

(defn ^Resources get-resources-by-package-name
  [^String package-name]
  (if-let [res (.get ^WeakHashMap resource-cache package-name)]
    res
    (let [^IPackageManager package-manager (get-service :package-manager)
          ^ApplicationInfo application-info (.getApplicationInfo package-manager
                                                                 package-name
                                                                 0 0)
          ^AssetManager asset-manager (AssetManager.)]
      (.addAssetPath asset-manager (.publicSourceDir application-info))
      (let [res (Resources. asset-manager nil nil)]
        (.put ^WeakHashMap resource-cache package-name res)
        res))))

get resources

(defn ^Resources get-resources
  [^PackageItemInfo package-item-info]
  (let [package-name (.packageName package-item-info)]
    (get-resources-by-package-name package-name)))

load string from resource

(defn ^String load-res-string
  [^PackageItemInfo package-item res non-localized]
  (let [resource (get-resources package-item)]
    (cond non-localized (str non-localized)
          (and resource
               res
               (not= res 0))
          (.getString resource res))))

load resource name from resource

(defn ^String load-res-resource-name
  [^PackageItemInfo package-item res]
  (let [resource (get-resources package-item)]
    (when (and resource
               res
               (not= res 0))
      (.getResourceName resource res))))

load drawable from resource

(defn ^Drawable load-res-drawable
  [^PackageItemInfo package-item res]
  (let [resource (get-resources package-item)]
    (when (and resource
               res
               (not= res 0))
      (.getDrawable resource res))))

parse PackageInfo

(defn parse-package-info
  [^PackageInfo package]
  (merge {}
         {:activities (set (map parse-activity-info
                                (.activities package)))
          :application-info (parse-application-info (.applicationInfo package))
          :config-preferences (set (map parse-configuration-info
                                        (.configPreferences package)))
          :first-install-time (.firstInstallTime package)
          :gids (set (.gids package))
          :install-location (#(case %
                                PackageInfo/INSTALL_LOCATION_AUTO
                                :auto
                                PackageInfo/INSTALL_LOCATION_INTERNAL_ONLY
                                :internal-only
                                PackageInfo/INSTALL_LOCATION_PREFER_EXTERNAL
                                :prefer-external
                                PackageInfo/INSTALL_LOCATION_UNSPECIFIED
                                :unspecified
                                %)
                             (.installLocation package))
          :instrumentation (set (map parse-instrumentation-info
                                     (.instrumentation package)))
          :last-update-time (.lastUpdateTime package)
          :package-name (.packageName package)
          :permissions (set (map parse-permission-info
                                 (.permissions package)))
          :providers (set (map parse-provider-info
                               (.providers package)))
          :receivers (set (map parse-activity-info
                               (.receivers package)))
          :req-features (set (map parse-feature-info
                                  (.reqFeatures package)))
          :requested-permissions (zipmap (vec (.requestedPermissions package))
                                         (vec (map #(let [flags (atom #{})]
                                                      (when (bit-and %
                                                                     PackageInfo/REQUESTED_PERMISSION_GRANTED)
                                                        (swap! flags conj :granted))
                                                      (when (bit-and %
                                                                     PackageInfo/REQUESTED_PERMISSION_REQUIRED)
                                                        (swap! flags conj :required))
                                                      @flags)
                                                   (.requestedPermissionsFlags package))))
          :required-account-type (.requiredAccountType package)
          :required-for-all-users (.requiredForAllUsers package)
          :restricted-account-type (.restrictedAccountType package)
          :services (set (map parse-service-info
                              (.services package)))
          :shared-user-id (.sharedUserId package)
          :shared-user-label (.sharedUserLabel package)
          :signatures (set (.signatures package))
          :version-code (.versionCode package)
          :version-name (.versionName package)}))

parse PackageItemInfo

(defn parse-package-item-info
  [^PackageItemInfo package-item]
  (merge {}
         {:icon (load-res-drawable package-item
                               (.icon package-item))
          :label (load-res-string package-item
                              (.labelRes package-item)
                              (.nonLocalizedLabel package-item))
          :label-res (.labelRes package-item)
          :logo (load-res-drawable package-item
                               (.logo package-item))
          :meta-data (.metaData package-item)
          :name (.name package-item)
          :non-localized-label (str (.nonLocalizedLabel package-item))
          :package-name (.packageName package-item)}))

parse ComponentInfo

(defn parse-component-info
  [^ComponentInfo component]
  (merge {}
         (parse-package-item-info component)
         {:application-info (parse-application-info (.applicationInfo component))
          :description  (load-res-string component
                                     (.descriptionRes component)
                                     nil)
          :description-res (.descriptionRes component)
          :enabled (.enabled component)
          :exported (.exported component)
          :process-name (.processName component)}))

parse ActivityInfo

(defn parse-activity-info
  [^ActivityInfo activity]
  (merge {}
         (parse-component-info activity)
         {:config-changes (#(let [flags (atom #{})]
                              (when (bit-and %
                                             ActivityInfo/CONFIG_DENSITY)
                                (swap! flags conj :density))
                              (when (bit-and %
                                             ActivityInfo/CONFIG_FONT_SCALE)
                                (swap! flags conj :font-scal))
                              (when (bit-and %
                                             ActivityInfo/CONFIG_KEYBOARD)
                                (swap! flags conj :keyboard))
                              (when (bit-and %
                                             ActivityInfo/CONFIG_KEYBOARD_HIDDEN)
                                (swap! flags conj :keyboard-hidden))
                              (when (bit-and %
                                             ActivityInfo/CONFIG_LAYOUT_DIRECTION)
                                (swap! flags conj :layout-direction))
                              (when (bit-and %
                                             ActivityInfo/CONFIG_LOCALE)
                                (swap! flags conj :locale))
                              (when (bit-and %
                                             ActivityInfo/CONFIG_MCC)
                                (swap! flags conj :mcc))
                              (when (bit-and %
                                             ActivityInfo/CONFIG_MNC)
                                (swap! flags conj :mnc))
                              (when (bit-and %
                                             ActivityInfo/CONFIG_NAVIGATION)
                                (swap! flags conj :navigation))
                              (when (bit-and %
                                             ActivityInfo/CONFIG_ORIENTATION)
                                (swap! flags conj :orientation))
                              (when (bit-and %
                                             ActivityInfo/CONFIG_SCREEN_LAYOUT)
                                (swap! flags conj :screen-layout))
                              (when (bit-and %
                                             ActivityInfo/CONFIG_SCREEN_SIZE)
                                (swap! flags conj :screen-size))
                              (when (bit-and %
                                             ActivityInfo/CONFIG_SMALLEST_SCREEN_SIZE)
                                (swap! flags conj :smallest-screen-size))
                              (when (bit-and %
                                             ActivityInfo/CONFIG_TOUCHSCREEN)
                                (swap! flags conj :touchscreen))
                              (when (bit-and %
                                             ActivityInfo/CONFIG_UI_MODE)
                                (swap! flags conj :ui-mode))
                              @flags)
                           (.configChanges activity))
          :flags (#(let [flags (atom #{})]
                     (when (bit-and %
                                    ActivityInfo/FLAG_ALLOW_TASK_REPARENTING)
                       (swap! flags conj :allow-task-reparenting))
                     (when (bit-and %
                                    ActivityInfo/FLAG_ALWAYS_RETAIN_TASK_STATE)
                       (swap! flags conj :always-retain-task-state))
                     (when (bit-and %
                                    ActivityInfo/FLAG_CLEAR_TASK_ON_LAUNCH)
                       (swap! flags conj :clear-task-on-launch))
                     (when (bit-and %
                                    ActivityInfo/FLAG_EXCLUDE_FROM_RECENTS)
                       (swap! flags conj :exclude-from-recents))
                     (when (bit-and %
                                    ActivityInfo/FLAG_FINISH_ON_CLOSE_SYSTEM_DIALOGS)
                       (swap! flags conj :finish-on-close-system-dialogs))
                     (when (bit-and %
                                    ActivityInfo/FLAG_FINISH_ON_TASK_LAUNCH)
                       (swap! flags conj :finish-on-task-launch))
                     (when (bit-and %
                                    ActivityInfo/FLAG_HARDWARE_ACCELERATED)
                       (swap! flags conj :hardware-accelerated))
                     (when (bit-and %
                                    ActivityInfo/FLAG_IMMERSIVE)
                       (swap! flags conj :immersive))
                     (when (bit-and %
                                    ActivityInfo/FLAG_MULTIPROCESS)
                       (swap! flags conj :multiprocess))
                     (when (bit-and %
                                    ActivityInfo/FLAG_NO_HISTORY)
                       (swap! flags conj :no-history))
                     (when (bit-and %
                                    ActivityInfo/FLAG_PRIMARY_USER_ONLY)
                       (swap! flags conj :primary-user-only))
                     (when (bit-and %
                                    ActivityInfo/FLAG_SHOW_ON_LOCK_SCREEN)
                       (swap! flags conj :show-on-lock-screen))
                     (when (bit-and %
                                    ActivityInfo/FLAG_SINGLE_USER)
                       (swap! flags conj :single-user))
                     (when (bit-and %
                                    ActivityInfo/FLAG_STATE_NOT_NEEDED)
                       (swap! flags conj :state-not-needed))
                     @flags)
                  (.flags activity))
          :launch-mode (#(case %
                           ActivityInfo/LAUNCH_MULTIPLE
                           :multiple
                           ActivityInfo/LAUNCH_SINGLE_INSTANCE
                           :single-instance
                           ActivityInfo/LAUNCH_SINGLE_TASK
                           :single-task
                           ActivityInfo/LAUNCH_SINGLE_TOP
                           :single-top
                           %)
                        (.launchMode activity))
          :parent-activity-name (.parentActivityName activity)
          :permission (.permission activity)
          :screen-orientation (#(case %
                                  ActivityInfo/SCREEN_ORIENTATION_BEHIND
                                  :behind
                                  ActivityInfo/SCREEN_ORIENTATION_FULL_SENSOR
                                  :full-sensor
                                  ActivityInfo/SCREEN_ORIENTATION_FULL_USER
                                  :full-user
                                  ActivityInfo/SCREEN_ORIENTATION_LANDSCAPE
                                  :landscape
                                  ActivityInfo/SCREEN_ORIENTATION_LOCKED
                                  :locked
                                  ActivityInfo/SCREEN_ORIENTATION_NOSENSOR
                                  :nosensor
                                  ActivityInfo/SCREEN_ORIENTATION_PORTRAIT
                                  :portrait
                                  ActivityInfo/SCREEN_ORIENTATION_REVERSE_LANDSCAPE
                                  :reverse-landscape
                                  ActivityInfo/SCREEN_ORIENTATION_REVERSE_PORTRAIT
                                  :reverse-potrait
                                  ActivityInfo/SCREEN_ORIENTATION_SENSOR
                                  :sensor
                                  ActivityInfo/SCREEN_ORIENTATION_SENSOR_LANDSCAPE
                                  :sensor-landscape
                                  ActivityInfo/SCREEN_ORIENTATION_SENSOR_PORTRAIT
                                  :sensor-portrait
                                  ActivityInfo/SCREEN_ORIENTATION_UNSPECIFIED
                                  :unspecified
                                  ActivityInfo/SCREEN_ORIENTATION_USER
                                  :user
                                  ActivityInfo/SCREEN_ORIENTATION_USER_LANDSCAPE
                                  :user-landscape
                                  ActivityInfo/SCREEN_ORIENTATION_USER_PORTRAIT
                                  :user-portrait
                                  %)
                               (.screenOrientation activity))
          :soft-input-mode (.softInputMode activity)
          :target-activity (.targetActivity activity)
          :task-affinity (.taskAffinity activity)
          :theme (load-res-resource-name activity
                                     (.theme activity))
          :ui-options (#(case %
                          ActivityInfo/UIOPTION_SPLIT_ACTION_BAR_WHEN_NARROW
                          :split-action-bar-when-narrow
                          %)
                       (.uiOptions activity))}))

parse ApplicationInfo

(defn parse-application-info
  [^ApplicationInfo application]
  (merge {}
         (parse-package-item-info application)
         {:backup-agent-name (.backupAgentName application)
          :class-name (.className application)
          :compatible-width-limit-dp (.compatibleWidthLimitDp application)
          :data-dir (.dataDir application)
          :description (load-res-string application
                                    (.descriptionRes application)
                                    nil)
          :description-res (.descriptionRes application)
          :enabled (.enabled application)
          :enabled-setting (.enabledSetting application)
          :flags (#(let [flags (atom #{})]
                     (when (bit-and %
                                    ApplicationInfo/FLAG_ALLOW_BACKUP)
                       (swap! flags conj :allow-backup))
                     (when (bit-and %
                                    ApplicationInfo/FLAG_ALLOW_CLEAR_USER_DATA)
                       (swap! flags conj :allow-clear-user-data))
                     (when (bit-and %
                                    ApplicationInfo/FLAG_ALLOW_TASK_REPARENTING)
                       (swap! flags conj :allow-task-reparenting))
                     (when (bit-and %
                                    ApplicationInfo/FLAG_CANT_SAVE_STATE)
                       (swap! flags conj :cant-save-state))
                     (when (bit-and %
                                    ApplicationInfo/FLAG_DEBUGGABLE)
                       (swap! flags conj :debuggable))
                     (when (bit-and %
                                    ApplicationInfo/FLAG_EXTERNAL_STORAGE)
                       (swap! flags conj :external-storage))
                     (when (bit-and %
                                    ApplicationInfo/FLAG_FACTORY_TEST)
                       (swap! flags conj :factory-test))
                     (when (bit-and %
                                    ApplicationInfo/FLAG_FORWARD_LOCK)
                       (swap! flags conj :forward-lock))
                     (when (bit-and %
                                    ApplicationInfo/FLAG_HAS_CODE)
                       (swap! flags conj :has-code))
                     (when (bit-and %
                                    ApplicationInfo/FLAG_INSTALLED)
                       (swap! flags conj :installed))
                     (when (bit-and %
                                    ApplicationInfo/FLAG_IS_DATA_ONLY)
                       (swap! flags conj :is-data-only))
                     (when (bit-and %
                                    ApplicationInfo/FLAG_KILL_AFTER_RESTORE)
                       (swap! flags conj :kill-after-restore))
                     (when (bit-and %
                                    ApplicationInfo/FLAG_LARGE_HEAP)
                       (swap! flags conj :large-heap))
                     (when (bit-and %
                                    ApplicationInfo/FLAG_PERSISTENT)
                       (swap! flags conj :persistent))
                     (when (bit-and %
                                    ApplicationInfo/FLAG_RESIZEABLE_FOR_SCREENS)
                       (swap! flags conj :resizeable-for-screens))
                     (when (bit-and %
                                    ApplicationInfo/FLAG_RESTORE_ANY_VERSION)
                       (swap! flags conj :restore-any-version))
                     (when (bit-and %
                                    ApplicationInfo/FLAG_STOPPED)
                       (swap! flags conj :stopped))
                     (when (bit-and %
                                    ApplicationInfo/FLAG_SUPPORTS_LARGE_SCREENS)
                       (swap! flags conj :supports-large-screens))
                     (when (bit-and %
                                    ApplicationInfo/FLAG_SUPPORTS_NORMAL_SCREENS)
                       (swap! flags conj :supports-normal-screens))
                     (when (bit-and %
                                    ApplicationInfo/FLAG_SUPPORTS_RTL)
                       (swap! flags conj :supports-rtl))
                     (when (bit-and %
                                    ApplicationInfo/FLAG_SUPPORTS_SCREEN_DENSITIES)
                       (swap! flags conj :supports-screen-densities))
                     (when (bit-and %
                                    ApplicationInfo/FLAG_SUPPORTS_SMALL_SCREENS)
                       (swap! flags conj :supports-small-screen))
                     (when (bit-and %
                                    ApplicationInfo/FLAG_SUPPORTS_XLARGE_SCREENS)
                       (swap! flags conj :supports-xlarge-screen))
                     (when (bit-and %
                                    ApplicationInfo/FLAG_SYSTEM)
                       (swap! flags conj :system))
                     (when (bit-and %
                                    ApplicationInfo/FLAG_TEST_ONLY)
                       (swap! flags conj :test-only))
                     (when (bit-and %
                                    ApplicationInfo/FLAG_UPDATED_SYSTEM_APP)
                       (swap! flags conj :updated-system-app))
                     (when (bit-and %
                                    ApplicationInfo/FLAG_VM_SAFE_MODE)
                       (swap! flags conj :vm-safe-mode))
                     @flags)
                  (.flags application))
          :install-location (.installLocation application)
          :largest-width-limit-dp (.largestWidthLimitDp application)
          :manage-space-activity-name (.manageSpaceActivityName application)
          :native-library-dir (.nativeLibraryDir application)
          :permission (.permission application)
          :process-name (.processName application)
          :public-source-dir (.publicSourceDir application)
          :requires-smallest-width-dp (.requiresSmallestWidthDp application)
          :resource-dirs (set (.resourceDirs application))
          :seinfo (.seinfo application)
          :shared-library-files (set (.sharedLibraryFiles application))
          :source-dir (.sourceDir application)
          :target-sdk-version (.targetSdkVersion application)
          :task-affinity (.taskAffinity application)
          :theme (load-res-resource-name application
                                     (.theme application))
          :uid (.uid application)
          :ui-options (.uiOptions application)}))

parse ConfigurationInfo

(defn parse-configuration-info
  [^ConfigurationInfo configuration]
  (merge {}
         {:req-gles-version (#(case %
                                ConfigurationInfo/GL_ES_VERSION_UNDEFINED
                                :undefined
                                %)
                             (.reqGlEsVersion configuration))
          :req-input-features (#(let [flags (atom #{})]
                                  (when (bit-and %
                                                 ConfigurationInfo/INPUT_FEATURE_FIVE_WAY_NAV)
                                    (swap! flags conj :five-way-nav))
                                  (when (bit-and %
                                                 ConfigurationInfo/INPUT_FEATURE_HARD_KEYBOARD)
                                    (swap! flags conj :hard-keyboard))
                                  @flags)
                               (.reqInputFeatures configuration))
          :req-keyboard-type (.reqKeyboardType configuration)
          :req-navigation (.reqNavigation configuration)
          :req-touch-screen (.reqTouchScreen configuration)}))

parse InstrumentationInfo

(defn parse-instrumentation-info
  [^InstrumentationInfo instrumentation]
  (merge {}
         (parse-package-item-info instrumentation)
         {:data-dir (.dataDir instrumentation)
          :functional-test (.functionalTest instrumentation)
          :handle-profiling (.handleProfiling instrumentation)
          :native-library-dir (.nativeLibraryDir instrumentation)
          :public-source-dir (.publicSourceDir instrumentation)
          :source-dir (.sourceDir instrumentation)
          :target-package (.targetPackage instrumentation)}))

parse PermissionGroupInfo

(defn parse-permission-group-info
  [^PermissionGroupInfo permission-group]
  (merge {}
         (parse-package-item-info permission-group)
         {:description (load-res-string permission-group
                                    (.descriptionRes permission-group)
                                    (.nonLocalizedDescription permission-group))
          :description-res (.descriptionRes permission-group)
          :flags (#(let [flags (atom #{})]
                     (swap! flags conj
                            (case %
                              PermissionGroupInfo/FLAG_PERSONAL_INFO :personal-info
                              %))
                     @flags)
                  (.flags permission-group))
          :non-localized-description (.nonLocalizedDescription permission-group)
          :priority (.priority permission-group)}))

parse PermissionInfo

(defn parse-permission-info
  [^PermissionInfo permission]
  (merge {}
         (parse-package-item-info permission)
         {:description (load-res-string permission
                                    (.descriptionRes permission)
                                    (.nonLocalizedDescription permission))
          :description-res (.descriptionRes permission)
          :flags (#(let [flags (atom #{})]
                     (when (bit-and %
                                    PermissionInfo/FLAG_COSTS_MONEY)
                       (swap! flags conj :costs-money))
                     @flags)
                  (.flags permission))
          :group (.group permission)
          :non-localized-description (str (.nonLocalizedDescription permission))
          :protection-level (#(let [flags (atom #{})
                                    protection-basic (bit-and %
                                                              PermissionInfo/PROTECTION_MASK_BASE)
                                    protection-flags (bit-and %
                                                              PermissionInfo/PROTECTION_MASK_FLAGS)]
                                (swap! flags conj
                                       (case protection-basic
                                         PermissionInfo/PROTECTION_DANGEROUS
                                         :dangerous
                                         PermissionInfo/PROTECTION_NORMAL
                                         :normal
                                         PermissionInfo/PROTECTION_SIGNATURE
                                         :signature
                                         PermissionInfo/PROTECTION_SIGNATURE_OR_SYSTEM
                                         :signature-or-system
                                         :unknown-protection-basic-level))
                                (when (bit-and protection-flags
                                               PermissionInfo/PROTECTION_FLAG_DEVELOPMENT)
                                  (swap! flags conj :development))
                                (when (bit-and protection-flags
                                               PermissionInfo/PROTECTION_FLAG_SYSTEM)
                                  (swap! flags conj :system))
                                @flags)
                             (.protectionLevel permission))}))

parse ProviderInfo

(defn parse-provider-info
  [^ProviderInfo provider]
  (merge {}
         (parse-component-info provider)
         {:authority (.authority provider)
          :flags (#(let [flags (atom #{})]
                     (when (bit-and %
                                    ProviderInfo/FLAG_SINGLE_USER)
                       (swap! flags conj
                              :single-user))
                     @flags)
                  (.flags provider))
          :grant-uri-permissions (.grantUriPermissions provider)
          :init-order (.initOrder provider)
          :multiprocess (.multiprocess provider)
          :path-permissions (set (.pathPermissions provider))
          :read-permission (.readPermission provider)
          :uri-permission-patterns (set (.uriPermissionPatterns provider))
          :write-permission (.writePermission provider)}))

parse FeatureInfo

(defn parse-feature-info
  [^FeatureInfo feature]
  (merge {}
         {:flags (set (#(let [flags (atom #{})]
                          (when (bit-and %
                                         FeatureInfo/FLAG_REQUIRED)
                            (swap! flags conj :required))
                          @flags)
                       (.flags feature)))
          :name (.name feature)
          :req-gles-version (#(case %
                                FeatureInfo/GL_ES_VERSION_UNDEFINED
                                :undefined
                                %)
                             (.reqGlEsVersion feature))}))

parse ServiceInfo

(defn parse-service-info
  [^ServiceInfo service]
  (merge {}
         (parse-component-info service)
         {:flags (#(let [flags (atom #{})]
                     (when (bit-and %
                                    ServiceInfo/FLAG_ISOLATED_PROCESS)
                       (swap! flags conj :isolated-process))
                     (when (bit-and %
                                    ServiceInfo/FLAG_SINGLE_USER)
                       (swap! flags conj :single-user))
                     (when (bit-and %
                                    ServiceInfo/FLAG_STOP_WITH_TASK)
                       (swap! flags conj :stop-with-task)))
                  (.flags service))
          :permission (.permission service)}))
 

manager users

(ns figurehead.api.os.user-manager.user-manager
  (:require (core [state :as state :refer [defcommand]]))  
  (:require (figurehead.util [services :as services :refer [get-service]]))
  (:require [figurehead.api.os.user-manager.user-manager-parser :as parser])
  (:require [clojure.string :as str]
            [clojure.java.io :as io]
            [clojure.set :as set :refer [subset?]])  
  (:import (android.content.pm UserInfo)
           (android.os IUserManager
                       UserHandle
                       UserManager)))
(declare create-user remove-user wipe-user set-user-name
         find-users find-user get-user-handle
         list-users get-max-users
         set-guest-enabled enable-guest disable-guest)

create a user

(defcommand create-user
  [{:keys [name]
    :as args}]
  (when name
    (let [^IUserManager user-manager (get-service :user-manager)]
      (let [name (str name)
            ^UserInfo info (.createUser user-manager name 0)]
        (when info
          (parser/parse-user-info info))))))

remove a user

(defcommand remove-user
  [{:keys [name
           serial-number
           id
           handle]
    :as args}]
  (when (or name serial-number id handle)
    (let [^IUserManager user-manager (get-service :user-manager)
          handle (get-user-handle args)]
      (when handle
        (.removeUser user-manager handle)))))

wipe a user

(defcommand wipe-user
  [{:keys [name
           serial-number
           id
           handle]
    :as args}]
  (when (or name serial-number id handle)
    (let [^IUserManager user-manager (get-service :user-manager)
          handle (get-user-handle args)]
      (when handle
        (.wipeUser user-manager handle)))))

set user to a new name

(defcommand set-user-name
  [{:keys [name
           serial-number
           id
           handle
           new-name]
    :as args}]
  (when (and new-name
             (or name serial-number id handle))
    (let [^IUserManager user-manager (get-service :user-manager)
          handle (get-user-handle args)]
      (when handle
        (.setUserName user-manager handle new-name)))))

find users by name, serial-number, id, or flags

(defcommand find-users
  [{:keys [name
           serial-number
           id
           flags]}]
  (when (or name serial-number id flags)
    (let [users (list-users {})]
      (cond name
            (filter #(= name (:name %))
                    users)
            serial-number
            (filter #(= serial-number (:serial-number %))
                    users)
            id
            (filter #(= id (:id %))
                    users)
            flags
            (filter #(subset? flags (:flags %))
                    users)))))

find a user by name, serial-number, or id

(defcommand find-user
  [{:keys [name
           serial-number
           id]
    :as args}]
  (when (or name serial-number id)
    (first (find-users args))))

get user handle

(defcommand get-user-handle
  [{:keys [name
           serial-number
           id
           handle]
    :as args}]
  (cond handle
        handle
        (or name serial-number id)
        (let  [^IUserManager user-manager (get-service :user-manager)
               user (find-user (merge {}
                                      (when name
                                        {:name name})
                                      (when serial-number
                                        {:serial-number serial-number})
                                      (when id
                                        {:id id})))]
          (when user
            (.getUserHandle user-manager (:serial-number user))))))

list all users

(defcommand list-users
  [{:keys []
    :as args}]
    (let [^IUserManager user-manager (get-service :user-manager)]
      (into #{}
            (map parser/parse-user-info
                 (.getUsers user-manager false)))))

get max number of supported users

(defcommand get-max-users
  [{:keys []
    :as args}]
  (UserManager/getMaxSupportedUsers))

set guest enable flag

(defcommand set-guest-enabled
  [{:keys [enabled?]
    :as args}]
  (let [^IUserManager user-manager (get-service :user-manager)]
    (.setGuestEnabled user-manager enabled?)))

enable guest

(defcommand enable-guest
  [{:keys []
    :as args}]
  (set-guest-enabled {:enabled? true}))

disable guest

(defcommand disable-guest
  [{:keys []
    :as args}]
  (set-guest-enabled {:enabled? false}))
 

parse User Manager objects into Clojure data structures

(ns figurehead.api.os.user-manager.user-manager-parser
  (:require (figurehead.util [services :as services :refer [get-service]]))
  (import (android.content.pm UserInfo)))
(declare parse-user-info)

parse UserInfo

(defn parse-user-info
  [^UserInfo user-info]
  (merge {}
         {:creation-time (.creationTime user-info)
          :flags (#(let [flags (atom #{})
                         user-type (bit-and %
                                            UserInfo/FLAG_MASK_USER_TYPE)]
                     (when (bit-and user-type
                                    UserInfo/FLAG_ADMIN)
                       (swap! flags conj :admin))
                     (when (bit-and user-type
                                    UserInfo/FLAG_GUEST)
                       (swap! flags conj :guest))
                     (when (bit-and user-type
                                    UserInfo/FLAG_INITIALIZED)
                       (swap! flags conj :initialized))
                     (when (bit-and user-type
                                    UserInfo/FLAG_PRIMARY)
                       (swap! flags conj :primary))
                     (when (bit-and user-type
                                    UserInfo/FLAG_RESTRICTED)
                       (swap! flags conj :restricted))
                     @flags)
                  (.flags user-info))
          :icon-path ^String (.iconPath user-info)
          :id (.id user-info)
          :last-logged-in-time (.lastLoggedInTime user-info)
          :name ^String (.name user-info)
          :partial (.partial user-info)
          :serial-number (.serialNumber user-info)}))
 

Android OS misc utils

(ns figurehead.api.os.util
  (:require (core [state :as state :refer [defcommand]]))  
  (:require (figurehead.util [services :as services :refer [get-service]]))
  (:require [clojure.string :as str]
            [clojure.java.io :as io]
            [clojure.set :as set :refer [subset?]])  
  (:import (android.os SystemProperties)))
(declare get-system-property set-system-property
         get-my-pid
         kill-process test-process)

get system property by name

(defcommand get-system-property
  [{:keys [name
           def
           int?
           long?
           boolean?]
    :as args}]
  {:pre [name]}
  (when-let [name (str name)]
    (cond int?
          (SystemProperties/getInt name (if def def -1))
          long?
          (SystemProperties/getLong name (if def def -1))
          boolean?
          (SystemProperties/getBoolean name (if def def false))
          :else
          (SystemProperties/get name (if def def "")))))

set system property by name to value

(defcommand set-system-property
  [{:keys [name
           value]
    :as args}]
  {:pre [name value]}
  (let [name (str name)
        value (str value)]
    (when (and name value)
      (SystemProperties/set name value))))

get my process id (pid)

(defcommand get-my-pid
  [{:keys []
    :as args}]
  {:pre []}
  (android.os.Process/myPid))

kill process by pid

(defcommand kill-process
  [{:keys [pid]
    :as args}]
  {:pre [pid]}
  (when pid
    (android.os.Process/killProcess pid)))

test whether process is running by pid

(defcommand test-process
  [{:keys [pid]
    :as args}]
  {:pre [pid]}
  (when pid
    (let [ppid (android.os.Process/getParentPid pid)]
      (if (> ppid 0)
        true
        false))))
 

file utils

(ns figurehead.api.util.file
  (:require (core [state :as state :refer [defcommand]]))  
  (:require (figurehead.util [services :as services :refer [get-service]]))
  (:require [clojure.string :as str]
            [clojure.java.io :as io])  
  (:import (android.content.res AssetManager
                                Resources)
           (android.util Base64)
           (java.io File)
           (org.apache.commons.io FileUtils)))
(declare decode-content-to-bytes encode-content-from-bytes
         decode-content-to-string encode-content-from-string
         decode-bytes-to-string encode-bytes-from-string
         
         write-file read-file)

decode from Base64-encoded content to bytes

(defcommand decode-content-to-bytes
  [{:keys [^String content]
    :as args}]
  {:pre [content]}
  (when (and content)
    ^bytes (Base64/decode content
                          Base64/DEFAULT)))

encode to Base64-encoded content from bytes

(defcommand encode-content-from-bytes
  [{:keys [^bytes bytes]
    :as args}]
  {:pre [bytes]}
  (when (and bytes)
    (Base64/encodeToString bytes
                           (bit-or Base64/NO_WRAP
                                   0))))

decode from Base64-encoded content to string

(defcommand decode-content-to-string
  [{:keys [^String content]
    :as args}]
  {:pre [content]}
  (when (and content)
    (decode-bytes-to-string {:bytes (decode-content-to-bytes {:content content})})))

encode to Base64-encoded content from string

(defcommand encode-content-from-string
  [{:keys [^String string]
    :as args}]
  {:pre [string]}
  (when (and string)
    (encode-content-from-bytes {:bytes (encode-bytes-from-string {:string string})})))

decode from bytes to UTF-8 string

(defcommand decode-bytes-to-string
  [{:keys [^bytes bytes]
    :as args}]
  {:pre [bytes]}
  (when (and bytes)
    (String. bytes "UTF-8")))

encode to bytes from UTF-8 string

(defcommand encode-bytes-from-string
  [{:keys [^String string]
    :as args}]
  {:pre [string]}
  (when (and string)
    (.getBytes string "UTF-8")))

write to file from string, Base64-encoded content, or bytes

(defcommand write-file
  [{:keys [file
           ^String string
           ^String content
           ^bytes bytes]
    :as args}]
  {:pre [file (or content string bytes)]}
  (when (and file (or content string bytes))
    (with-open [the-file (io/output-stream (io/file file))]
      (let [bytes (cond string
                        (encode-bytes-from-string string)
                        content
                        (decode-content-to-bytes content)
                        bytes
                        bytes)]
        (.write the-file ^bytes bytes)))))

read from file to string, Base64-encoded content, or bytes

(defcommand read-file
  [{:keys [file
           string?
           content?
           bytes?]
    :as args}]
  {:pre [file (or string? content? bytes?)]}
  (when (and file (or string? content? bytes?))
    (let [^bytes bytes (FileUtils/readFileToByteArray (io/file file))]
      (cond string?
            (decode-bytes-to-string {:bytes bytes})
            content?
            (encode-content-from-bytes {:bytes bytes})
            bytes?
            bytes))))
 

input (Input Events) wrapper

https://github.com/android/platformframeworksbase/blob/android-4.3_r3.1/cmds/input/src/com/android/commands/input/Input.java

(ns figurehead.api.view.input
  (:require (core [state :as state :refer [defcommand]]))  
  (:require (figurehead.util [services :as services :refer [get-service]]))
  (:require [clojure.string :as str]
            [clojure.java.io :as io])
  (:import (android.hardware.input InputManager)
           (android.os SystemClock)
           (android.view InputDevice
                         KeyCharacterMap
                         KeyEvent
                         MotionEvent)))
(declare
 ;; porcelain
 text key-event tap swipe
 touchscreen touchpad touch-navigation
 trackball
 ;; plumbing
 send-text send-key-event
 send-tap send-swipe send-move
 inject-key-event inject-motion-event)

porcelain

(defcommand text
  [{:keys [^String text]
    :as args}]
  (when text
    (send-text (merge args
                      {:text text}))))
(defcommand key-event
  [{:keys [^String key-code meta-state]
    :or {meta-state 0}
    :as args}]
  (let [str-to-key-code (fn [str-key-code prefix]
                          (let [key-code (KeyEvent/keyCodeFromString str-key-code)]
                            (if (= key-code KeyEvent/KEYCODE_UNKNOWN)
                              (KeyEvent/keyCodeFromString (str prefix
                                                               (str/upper-case str-key-code)))
                              key-code)))]
    (let [key-code (cond (number? key-code)
                         key-code
                         (string? key-code)
                         (str-to-key-code key-code "KEYCODE_"))
          meta-state (cond (number? meta-state)
                           meta-state
                           (string? meta-state)
                           (str-to-key-code meta-state "META_")
                           (sequential? meta-state)
                           (reduce bit-or
                                   0
                                   (map #(str-to-key-code % "META_") meta-state)))]
      (when (and key-code meta-state)
        (send-key-event (merge args
                               {:key-code key-code
                                :meta-state meta-state}))))))
(defcommand tap
  [{:keys [x y]
    :as args}]
  (when (and x y)
    (send-tap (merge args
                     {:input-source InputDevice/SOURCE_TOUCHSCREEN
                      :x x
                      :y y}))))
(defcommand swipe
  [{:keys [x1 y1 x2 y2]
    :as args}]
  (when (and x1 y1 x2 y2)
    (send-swipe (merge args
                       {:input-source InputDevice/SOURCE_TOUCHSCREEN
                        :x1 x1 :y1 y1
                        :x2 x2 :y2 y2
                        :duration -1}))))
(let [common-procedure (fn [input-source action args]
                         (case action
                           :tap
                           (do
                             (let [{:keys [x y]} args]
                               (when (and x y)
                                 (send-tap (merge args
                                                  {:input-source input-source
                                                   :x x :y y})))))
                           :swipe
                           (do
                             (let [{:keys [x1 y1 x2 y2 duration]} args]
                               (when (and x1 y1 x2 y2)
                                 (send-swipe (merge args
                                                    {:input-source input-source
                                                     :x1 x1 :y1 y1
                                                     :x2 x2 :y2 y2
                                                     :duration (if duration
                                                                 duration
                                                                 -1)})))))
                           :else))]
  (defcommand touchscreen
    [{:keys [action]
      :as args}]
    (common-procedure InputDevice/SOURCE_TOUCHSCREEN (or action :tap) args))
  (defcommand touchpad
    [{:keys [action]
      :as args}]
    (common-procedure InputDevice/SOURCE_TOUCHPAD (or action :tap) args))
  (defcommand touch-navigation
    [{:keys [action]
      :as args}]
    (common-procedure InputDevice/SOURCE_TOUCH_NAVIGATION (or action :tap) args)))
(defcommand trackball
  [{:keys [action]
    :as args}]
  (let [input-source InputDevice/SOURCE_TRACKBALL]
    (case action
      :press
      (do
        (send-tap (merge args
                         {:input-source input-source
                          :x 0.0 :y 0.0})))
      :roll
      (do
        (let [{:keys [dx dy]} args]
          (when (and dx dy)
            (send-move (merge args
                              {:input-source input-source
                               :dx dx :dy dy})))))
      :else)))

plumbing

convert the characters of string text into key events and send to the device

(defcommand send-text
  [{:keys [^String text]
    :as args}]
  (let [kcm ^KeyCharacterMap (KeyCharacterMap/load KeyCharacterMap/VIRTUAL_KEYBOARD)]
    (doseq [^KeyEvent event (.getEvents kcm (.toCharArray text))]
      (inject-key-event {:event event}))))

send key event

(defcommand send-key-event
  [{:keys [key-code
           meta-state]
    :or {meta-state 0}
    :as args}]
  (let [now (SystemClock/uptimeMillis)
]
    (inject-key-event {:event (KeyEvent. now now KeyEvent/ACTION_DOWN key-code 0 meta-state
                                         KeyCharacterMap/VIRTUAL_KEYBOARD 0 0 InputDevice/SOURCE_KEYBOARD)})
    (inject-key-event {:event (KeyEvent. now now KeyEvent/ACTION_UP key-code 0 meta-state
                                         KeyCharacterMap/VIRTUAL_KEYBOARD 0 0 InputDevice/SOURCE_KEYBOARD)})))

send tap event

(defcommand send-tap
  [{:keys [input-source
           x y]
    :or {input-source InputDevice/SOURCE_TOUCHSCREEN}
    :as args}]
  (let [now (SystemClock/uptimeMillis)]
    (inject-motion-event {:input-source input-source
                          :action MotionEvent/ACTION_DOWN
                          :when now
                          :x x
                          :y y
                          :pressure 1.0})
    (inject-motion-event {:input-source input-source
                          :action MotionEvent/ACTION_UP
                          :when now
                          :x x
                          :y y
                          :pressure 0.0})))

send swipe event

(defcommand send-swipe
  [{:keys [input-source
           x1 y1
           x2 y2
           duration]
    :or {input-source InputDevice/SOURCE_TOUCHSCREEN}
    :as args}]
  (let [now (SystemClock/uptimeMillis)
        duration (if (>= duration 0) duration 300)
        start-time now
        end-time (+ now duration)
        lerp (fn [x y alpha]
               (+ x
                  (* alpha
                     (- y x))))]
    (inject-motion-event {:input-source input-source
                          :action MotionEvent/ACTION_DOWN
                          :when now
                          :x x1
                          :y y1
                          :pressure 1.0})
    (loop [now now]
      (if (< now end-time)
        (do
          (let [elapsed-time (- now start-time)
                alpha (/ (float elapsed-time) duration)]
            (inject-motion-event {:input-source input-source
                                  :action MotionEvent/ACTION_MOVE
                                  :when now
                                  :x (lerp x1 x2 alpha)
                                  :y (lerp y1 y2 alpha)
                                  :pressure 1.0}))
          (recur (SystemClock/uptimeMillis)))
        (inject-motion-event {:input-source input-source
                              :action MotionEvent/ACTION_UP
                              :when now
                              :x x2
                              :y y2
                              :pressure 0.0})))))

send a zero-pressure move event

(defcommand send-move
  [{:keys [input-source
           dx dy]
    :or {input-source InputDevice/SOURCE_TOUCHSCREEN}
    :as args}]
  (let [now (SystemClock/uptimeMillis)]
    (inject-motion-event {:input-source input-source
                          :action MotionEvent/ACTION_MOVE
                          :when now
                          :x dx
                          :y dy
                          :pressure 0.0})))

inject a key event

(defcommand inject-key-event
  [{:keys [^KeyEvent event]
    :as args}]
  (.. (InputManager/getInstance)
      (injectInputEvent event
                        InputManager/INJECT_INPUT_EVENT_MODE_WAIT_FOR_FINISH)))

inject a motion event

(defcommand inject-motion-event
  [{:keys [input-source
           action
           when
           meta-state
           x y
           pressure]
    :or {input-source InputDevice/SOURCE_TOUCHSCREEN
         meta-state 0}    
    :as args}]
  (let [size 1.0
        precision-x 1.0
        precision-y 1.0
        device-id 0
        edge-flags 0
        event (MotionEvent/obtain when when action x y pressure
                                  size meta-state precision-x precision-y device-id edge-flags)]
    (.setSource event input-source)
    (.. (InputManager/getInstance)
        (injectInputEvent event
                          InputManager/INJECT_INPUT_EVENT_MODE_WAIT_FOR_FINISH))))
 

main entry into Figurehead

(ns figurehead.main
  (:require (figurehead.util [init :as init]))
  (:require (core main
                  state
                  init))
  ;; these "require" are needed to handle lein-droid's :aot "removing unused namespace from classpath" feature
  (:require core.plugin.echo.main
            core.plugin.command-executor.main
            figurehead.plugin.unique-instance.main
            figurehead.plugin.nrepl.main
            figurehead.plugin.monitor.main
            figurehead.plugin.mastermind.main)
  (:import (android.os SystemProperties))
  (:gen-class))

the main entry

(defn -main
  [& args]
  (init/init)
  (core.init/require-and-set-default-plugins core.plugin.echo
                                             core.plugin.command-executor
                                             figurehead.plugin.unique-instance
                                             figurehead.plugin.nrepl
                                             figurehead.plugin.monitor
                                             figurehead.plugin.mastermind)
  (apply core.main/main args))
 

connect to Mastermind

(ns figurehead.plugin.mastermind.main
  (:require (core [init :as init]
                  [state :as state]
                  [bus :as bus]
                  [plugin :as plugin]))
  (:require (figurehead.util [unique-instance :refer [set-meta-data-entry
                                                      register-meta-data-entry]]))
  (:require [clojure.string :as str]
            [clojure.java.io :as io]
            [clojure.stacktrace :refer [print-stack-trace]]
            [clojure.pprint :refer [pprint]]
            [clojure.core.async
             :as async
             :refer [thread chan <!! >!!]])
  (:import
   (java.net Socket
             SocketTimeoutException)))
(def defaults
  (atom
   {
    :stop-unblock-tag :stop-figurehead.plugin.mastermind
    :mastermind-port 4321
    :socket-timeout 15000
    :writer-buffer 1000
    }))
(defn populate-parse-opts-vector
  [current-parse-opts-vector]
  (init/add-to-parse-opts-vector [
                                  ["-a"
                                   "--mastermind-address ADDR"
                                   "mastermind address"]
                                  (let [option :mastermind-port
                                        default (option @defaults)]
                                    ["-p"
                                     (str "--"
                                          (name option)
                                          " [PORT]")
                                     (str "mastermind port")
                                     :default default
                                     :parse-fn (get-in @init/parse-opts-vector-helper
                                                       [:parse-fn :inet-port])])
                                  ]))
(defn init
  [options]
  (register-meta-data-entry :mastermind-address)
  (register-meta-data-entry :mastermind-port)
  (when (and (:mastermind-address options)
             (:mastermind-port options))
    true))
(defn run
  [options]
  (let [verbose (:verbose options)
        mastermind-address (:mastermind-address options)
        mastermind-port (:mastermind-port options)
        instance-id (state/get-state :instance-id)]
    (set-meta-data-entry :mastermind-address mastermind-address)
    (set-meta-data-entry :mastermind-port mastermind-port)
    (let [sock (Socket. ^String mastermind-address
                        ^int mastermind-port)]
      (plugin/blocking-jail [
                             ;; timeout
                             nil
                             ;; unblock-tag
                             (:stop-unblock-tag @defaults)
                             ;; finalization
                             (do
                               (.close sock))
                             ;; verbose
                             verbose
                             ]
                            (.setSoTimeout sock (:socket-timeout @defaults))
                            ;; reader thread
                            (thread
                              (with-open [^java.io.BufferedReader reader (io/reader sock)]
                                (plugin/looping-jail [
                                                      ;; stop condition
                                                      (plugin/get-state-entry :stop)
                                                      ;; finalization
                                                      (do
                                                        (.close sock))
                                                      ;; verbose
                                                      verbose
                                                      ]
                                                     (try
                                                       (when-let [line (.readLine reader)]
                                                         (try
                                                           (let [message (read-string line)
                                                                 topic (bus/get-message-topic message)
                                                                 content (bus/remove-message-topic message)]
                                                             (when verbose
                                                               (pprint [:mastermind :reader message]))
                                                             (case topic
                                                               :command
                                                               (do
                                                                 (bus/say!! :command content))
                                                               :else))
                                                           (catch RuntimeException e
                                                             (when verbose
                                                               (print-stack-trace e)))))
                                                       (catch SocketTimeoutException e
                                                         (when verbose
                                                           (print-stack-trace e)))))))
                            ;; writer thread
                            (thread
                              (with-open [^java.io.BufferedWriter writer (io/writer sock)]
                                (let [ch (chan (:writer-buffer @defaults))]
                                  (bus/register-listener ch)
                                  (plugin/looping-jail [
                                                        ;; stop condition
                                                        (plugin/get-state-entry :stop)
                                                        ;; finalization
                                                        (do
                                                          (bus/unregister-listener ch)
                                                          (.close sock))
                                                        ;; verbose
                                                        verbose
                                                        ]
                                                       (let [message (<!! ch)
                                                             topic (bus/get-message-topic message)
                                                             content (bus/remove-message-topic message)]
                                                         (cond
                                                          ;; do NOT echo these topics back
                                                          (not (contains? #{:command} topic))
                                                          (let [message (bus/build-message topic
                                                                                           (cond
                                                                                            (map? content)
                                                                                            (merge content
                                                                                                   {:instance instance-id})
                                                                                            :else
                                                                                            {:instance instance-id
                                                                                             :content message}))]
                                                            (when verbose
                                                              (pprint [:mastermind :writer message]))
                                                            (.write writer
                                                                    (prn-str message))
                                                            (.flush writer))))))))))))
(defn stop
  []
  (plugin/set-state-entry :figurehead.plugin.mastermind
                          :stop true)
  (plugin/unblock-thread (:stop-unblock-tag @defaults)))

the config map

(def config-map
  {:populate-parse-opts-vector populate-parse-opts-vector
   :init init
   :run run
   :stop stop
   :param {:priority 90
           :auto-restart true}})
 

monitor Activities

(ns figurehead.plugin.monitor.main
  (:require (core [init :as init]
                  [state :as state]
                  [bus :as bus]
                  [plugin :as plugin]))
  (:require (figurehead.util [services :as services :refer [get-service]]))
  (:require (figurehead.api.app [activity-controller :as activity-controller]))
  (:require (figurehead.util [unique-instance :refer [set-meta-data-entry
                                                      register-meta-data-entry]]))
  (:require [clojure.string :as str]
            [clojure.core.async :as async])
  (:import
   (android.text.format Time)
   (android.app IActivityManager
                IActivityController$Stub
                ActivityManager$RunningAppProcessInfo)
   (android.content Intent)
   (android.content.pm IPackageManager
                       PackageManager
                       ActivityInfo
                       ServiceInfo
                       ProviderInfo)))
(def defaults
  (atom
   {
    :stop-unblock-tag :stop-figurehead.plugin.monitor
    }))
(defn populate-parse-opts-vector
  [current-parse-opts-vector]
  (init/add-to-parse-opts-vector [
                                  ["-m"
                                   "--monitor"
                                   "enter monitor mode"]
                                  ]))
(defn init
  [options]
  (register-meta-data-entry :monitor)
  (when (:monitor options)
    true))
(defn run
  [options]
  (let [verbose (:verbose options)
        now (Time.)
        activity-manager ^IActivityManager (get-service :activity-manager)
        activity-starting (fn [^Intent intent package]
                            (locking intent
                              (bus/say!! :activity-controller
                                         {:event :starting
                                          :timestamp (do (.setToNow now)
                                                         (.toMillis now true))
                                          :package (-> package keyword)
                                          :intent-action (-> intent .getAction keyword)
                                          ;; the "/" prevents straightforward keyword-ize
                                          :intent-component (str 
                                                             (.. intent getComponent getPackageName)
                                                             "/"
                                                             (.. intent getComponent getShortClassName))
                                          :intent-category (into #{} (map keyword
                                                                          (.getCategories intent)))
                                          ;; data and extras may contain non-keyword-izable content
                                          :intent-data (-> intent .getDataString)
                                          :intent-extras (-> intent .getExtras)
                                          :intent-flags (-> intent .getFlags)
                                          }
                                         verbose))
                            true)
        activity-resuming (fn [package]
                            (bus/say!! :activity-controller
                                       {:event :resuming
                                        :timestamp (do (.setToNow now)
                                                       (.toMillis now true))
                                        :package (-> package keyword)
                                        })
                            true)
        app-crashed (fn  [process-name pid
                          short-msg long-msg
                          time-millis stack-trace]
                      (doseq [^ActivityManager$RunningAppProcessInfo app-proc
                              (.getRunningAppProcesses activity-manager)]
                        (when (and (= pid (.pid app-proc))
                                   (= process-name (.processName app-proc)))
                          (bus/say!! :activity-controller
                                     {:event :crashed
                                      :timestamp (do (.setToNow now)
                                                     (.toMillis now true))
                                      :packages (into #{}
                                                      (map keyword
                                                           (.pkgList app-proc)))})))
                      true)
        app-early-not-responding (fn [process-name pid annotation]
                                   1)
        app-not-responding (fn [process-name pid process-stats]
                             1)
        system-not-responding (fn [msg]
                                1)]
    (set-meta-data-entry :monitor true)
    (plugin/blocking-jail [
                           ;; timeout
                           nil
                           ;; unblock-tag
                           (:stop-unblock-tag @defaults)
                           ;; finalization
                           (do
                             (activity-controller/set-activity-controller
                              {:reset? true}))
                           ;; verbose
                           verbose
                           ]
                          (activity-controller/set-activity-controller
                           {:activity-starting activity-starting
                            :activity-resuming activity-resuming
                            :app-crashed app-crashed
                            :app-early-not-responding app-early-not-responding
                            :app-not-responding app-not-responding
                            :system-not-responding system-not-responding}))))
(defn stop
  [options]
  (plugin/set-state-entry :figurehead.plugin.monitor
                          :stop true)
  (plugin/unblock-thread (:stop-unblock-tag @defaults)))

the config map

(def config-map
  {:populate-parse-opts-vector populate-parse-opts-vector
   :init init
   :run run
   :stop stop
   :param {:priority 1
           :auto-restart false}})
 

helper for starting nREPL server

acknowledgement: https://github.com/clojure-android/neko

(ns figurehead.plugin.nrepl.helper
  (:require (core [plugin :as plugin]))
  (:require [clojure.java.io :refer [file delete-file]]
            [clojure.tools.nrepl.server :as nrepl-server]
            clojure.tools.nrepl.middleware.interruptible-eval)
  (:import java.io.File
           java.util.concurrent.atomic.AtomicLong
           java.util.concurrent.ThreadFactory))
(declare enable-dynamic-compilation
         clean-cache
         start-repl)
(def defaults
  (atom
   {
    :repl-worker-thread-stack-size 8388608     ; nrepl 8M
    }))

ref: neko.compilation

(def ^{:doc 
       :private true}
  cache-path (atom nil))
(defn- android-thread-factory
  []
  (let [counter (AtomicLong. 0)]
    (reify ThreadFactory
      (newThread [_ runnable]
        (doto (Thread. (.getThreadGroup (Thread/currentThread))
                       runnable
                       (format "nREPL-worker-%s" (.getAndIncrement counter))
                       (:repl-worker-thread-stack-size @defaults))
          (.setDaemon true))))))

get absolute path of name

(defn- get-absolute-path-from-cwd
  [& path-components]
  (clojure.string/join File/separator
                       ;; http://developer.android.com/reference/java/lang/System.html
                       ;; (into [(System/getProperty "java.io.tmpdir")]
                       ;;       path-components)
                       ;; http://developer.android.com/reference/dalvik/system/DexClassLoader.html
                       ;; Do not cache optimized classes on external storage. External storage does not provide access controls necessary to protect your application from code injection attacks.
                       (into ["/data/dalvik-cache/"]
                             path-components)))

enable dynamic compilation; adapt from neko.compilation/init

(defn enable-dynamic-compilation
  [clojure-cache-dir]
  (let [path (get-absolute-path-from-cwd clojure-cache-dir)]
    (.mkdir (file path))
    (plugin/set-state-entry :repl-dynamic-compilation-path
                            path)
    (reset! cache-path path)
    (System/setProperty "clojure.compile.path" path)
    (alter-var-root #'clojure.core/*compile-path*
                    (constantly path))
    ;; clean staled cache
    (clean-cache)))

from neko.compilation

(defn- cache-file?
  [^String name]
  (and (.startsWith name "repl-")
       (or (.endsWith name ".dex")
           (.endsWith name ".jar"))))

clean compilation cache

(defn clean-cache
  []
  (locking cache-path
    (when-let [cache-path @cache-path]
      (doseq [^File f (file-seq (file cache-path))]
        (try
          (when (and (.isFile f)
                     (cache-file? (.getName f)))
            ;; wierd EBUSY error: http://stackoverflow.com/a/11776458
            (let [^File tmp (file (str (.getAbsolutePath f)
                                       (System/currentTimeMillis)))]
              (.renameTo f tmp)
              (delete-file tmp)))
          (catch Exception e)))
      ;; remake the directory if necessary
      (let [^File compile-path (file cache-path)]
        (when-not (.exists compile-path)
          (.mkdir compile-path))))))

neko.init/start-repl

(defn start-repl
  [& repl-args]
  (binding [*ns* (create-ns 'user)]
    (refer-clojure)
    (use 'clojure.repl)
    (use 'clojure.pprint)
    (use 'clojure.java.io)
    (require '(clojure [string :as str]
                       [set :as set]
                       [stacktrace :as stacktrace
                        :refer [print-stack-trace]]))
    ;; Android API wrapper
    (require '[figurehead.api.app.activity-manager :as activity-manager])
    (require '[figurehead.api.content.intent :as intent])
    (require '[figurehead.api.content.pm.package-manager :as package-manager])
    (require '[figurehead.api.content.pm.package-manager-parser :as package-manager-parser])
    (require '[figurehead.api.view.input :as input])
    (require '[figurehead.api.os.user-manager.user-manager :as user-manager])
    (require '[figurehead.api.os.user-manager.user-manager-parser :as user-manager-parser])
    (require '[figurehead.api.os.util :as os-util])
    (require '[figurehead.api.util.file :as util-file])
    (require '(core [bus :as bus]
                    [plugin :as plugin]
                    [state :as state]))
    (try
      (require 'compliment.core)
      (catch Exception e))
    (use 'clojure.tools.nrepl.server)
    (require '[clojure.tools.nrepl.middleware.interruptible-eval :as ie])
    (with-redefs-fn {(resolve 'ie/configure-thread-factory)
                     android-thread-factory}
      #(apply (resolve 'start-server) repl-args))))
 

nREPL server with cider-nrepl middleware support

(ns figurehead.plugin.nrepl.main
  (:require (core [init :as init]
                  [state :as state]
                  [bus :as bus]
                  [plugin :as plugin]))
  (:require [figurehead.plugin.nrepl.helper :as helper])
  (:require (figurehead.util [unique-instance :refer [set-meta-data-entry
                                                      register-meta-data-entry]]))
  (:require [clojure.tools.nrepl.server :as nrepl-server]
            ;; comment out the middlewares that are incompatible with Dalvik
            (cider.nrepl.middleware apropos
                                    classpath
                                    complete
                                    ;;info
                                    inspect
                                    macroexpand
                                    resource
                                    stacktrace
                                    test
                                    ;;trace)
            ;;[cider.nrepl :refer [cider-nrepl-handler]]
            compliment.core
            complete.core
            [clojure.stacktrace :refer [print-stack-trace]]
            [clojure.core.async
             :as async
             :refer [<!! chan]])
  (:import (java.util.concurrent TimeUnit
                                 ScheduledThreadPoolExecutor
                                 Executors
                                 ScheduledFuture)))
(def defaults
  (atom
   {
    :repl-clojure-cache-dir "figurehead-cache"
    :stop-unblock-tag :stop-figurehead.plugin.nrepl
    :clean-cache-interval (* 15 60)
    }))
(defn populate-parse-opts-vector
  [current-parse-opts-vector]
  (init/add-to-parse-opts-vector [
                                  (let [option :nrepl-port]
                                    ["-R"
                                     (str "--"
                                          (name option)
                                          " [PORT]")
                                     (str "nREPL port")
                                     :parse-fn (get-in @init/parse-opts-vector-helper
                                                       [:parse-fn :inet-port])])
                                  ]))
(defn init
  [options]
  (register-meta-data-entry :nrepl-port)
  (when (and (:nrepl-port options))
    true))

A vector containing all CIDER middleware.

(def ^:private cider-middleware
  '[cider.nrepl.middleware.apropos/wrap-apropos
    cider.nrepl.middleware.classpath/wrap-classpath
    cider.nrepl.middleware.complete/wrap-complete
    ;;cider.nrepl.middleware.info/wrap-info
    cider.nrepl.middleware.inspect/wrap-inspect
    cider.nrepl.middleware.macroexpand/wrap-macroexpand
    cider.nrepl.middleware.resource/wrap-resource
    cider.nrepl.middleware.stacktrace/wrap-stacktrace
    cider.nrepl.middleware.test/wrap-test
    ;;cider.nrepl.middleware.trace/wrap-trace
    ])

CIDER's nREPL handler.

(def ^:private cider-nrepl-handler
  (apply nrepl-server/default-handler (map resolve cider-middleware)))
(defn run
  [options]
  (let [verbose (:verbose options)
        nrepl-port (:nrepl-port options)
        scheduler ^ScheduledThreadPoolExecutor (Executors/newScheduledThreadPool 1)
        clean-cache-task (delay ^ScheduledFuture
                                (.scheduleAtFixedRate scheduler
                                                      #(helper/clean-cache)
                                                      (:clean-cache-interval @defaults)
                                                      (:clean-cache-interval @defaults)
                                                      TimeUnit/SECONDS))]
    (set-meta-data-entry :nrepl-port nrepl-port)
    (plugin/blocking-jail [
                           ;; timeout
                           nil
                           ;; unblock-tag
                           (:stop-unblock-tag @defaults)
                           ;; finalization
                           (do
                             (nrepl-server/stop-server (plugin/get-state-entry :nrepl-server))
                             (.cancel ^ScheduledFuture @clean-cache-task true)
                             (helper/clean-cache))
                           ;; verbose
                           verbose
                           ]
                          (helper/enable-dynamic-compilation (:repl-clojure-cache-dir @defaults))
                          (when verbose
                            (prn [:repl-dynamic-compilation-path
                                  (plugin/get-state-entry :repl-dynamic-compilation-path)]))
                          (plugin/set-state-entry :nrepl-server
                                                  (helper/start-repl :port nrepl-port
                                                                     :handler cider-nrepl-handler))
                          (plugin/register-exit-hook :figurehead.plugin.nrepl.clean-cache
                                                     #(helper/clean-cache))
                          ;; trigger the delayed task
                          @clean-cache-task)))
(defn stop
  [options]
  (plugin/set-state-entry :core.plugin.nrepl
                          :stop true)
  (plugin/unblock-thread (:stop-unblock-tag @defaults)))

the config map

(def config-map
  {
   :populate-parse-opts-vector populate-parse-opts-vector
   :init init
   :run run
   :stop stop
   :param {:priority 1
           :auto-restart true}})
 

ensuring a unique instance of figurehead

(ns figurehead.plugin.unique-instance.main
  (:require (core [init :as init]
                  [state :as state]
                  [bus :as bus]
                  [plugin :as plugin]))
  (:use (figurehead.util unique-instance))
  (:require (clojure [pprint :refer [pprint]]))
  (:import (android.os SystemProperties)))
(def defaults
  (atom
   {}))
(defn populate-parse-opts-vector
  [current-parse-opts-vector]
  (init/add-to-parse-opts-vector [
                                  (let [option :kill]
                                    [nil
                                     (str "--"
                                          (name option))
                                     (str "kill existing instance and exit")])
                                  (let [option :replace]
                                    [nil
                                     (str "--"
                                          (name option))
                                     (str "replace existing instance and continue")])
                                  (let [option :status]
                                    [nil
                                     (str "--"
                                          (name option))
                                     (str "return status of existing instance and exit")])
                                  ]))
(defn init
  [options]
  true)
(defn run
  [options]
  (let [kill? (:kill options)
        replace? (:replace options)
        status? (:status options)]
    (cond status?
          (do
            (let [is-running? (is-running?)]
              (pprint (if is-running?
                        {:is-running? true
                         :state (get-meta-data)}
                        (do
                          (unset-meta-data)
                          {:is-running? false}))))
            (System/exit 0))
          kill?
          (do
            (kill-existing-instance)
            (System/exit 0)))
    (if replace?
      (replace-existing-instance)
      (keep-existing-instance))))

the config map

(def config-map
  {
   :populate-parse-opts-vector populate-parse-opts-vector
   :init init
   :run run
   ;;:stop stop
   :param {:priority 1
           ;;:auto-restart true
           }})
 

figurehead helpers

(ns figurehead.ui.helper.figurehead
  (:use (figurehead.ui su
                       util))
  (:require (neko [threading :refer [on-ui]]
                  [notify :refer [toast]]))
  (:require (clojure [string :as str]
                     [set :as set]
                     [pprint :refer [pprint]]
                     [stacktrace :refer [print-stack-trace]]))
  (:import (android.content Context))
  (:import (android.widget Switch
                           Button
                           CheckBox
                           EditText
                           TextView
                           ScrollView)
           (android.view View)
           (java.util List)))
(declare get-figurehead-apk-path build-figurehead-command
         figurehead-is-running? get-running-figurehead-state)

get path to the backing APK

(defn get-figurehead-apk-path
  [^Context context]
  (let [apk-path (get-app-info-entry :apk-path)]
    ;; if already
    (if apk-path
      apk-path
      (when-let [package-manager (.getPackageManager context)]
        (let [package-name (.getPackageName context)]
          (when-let [app-info
                     (.getApplicationInfo package-manager
                                          package-name 0)]
            (let [apk-path (.publicSourceDir app-info)]
              (set-app-info-entry :apk-path apk-path)
              apk-path)))))))

build figurehead command to feed SU

(defn build-figurehead-command
  [& commands]
  (when-let [figurehead-script @(get-app-info-entry :figurehead-script)]
    (str/join " " (into [figurehead-script] commands))))

fast check of whether figurehead is running based on external commands

the SU instance for figurehead-is-running?

(def ^:private su-figurehead-is-running
  (atom nil))

return whether figurehead is running

(defn figurehead-is-running?
  []
  (let [is-running? (promise)
        commands ["pgrep -f figurehead.main"]
        timeout 60]
    (execute-root-command :commands commands
                          :timeout timeout
                          :callback? true
                          :buffered? true
                          :on-normal
                          (do
                            (try
                              (deliver is-running?
                                       (and output
                                            (not (empty? (.trim (str/join " " output))))))
                              (catch Exception e
                                (print-stack-trace e)
                                (deliver is-running? false))))
                          :on-error
                          (do
                            (deliver is-running?
                                     false))
                          :error-message
                          "Cannot determine whether Figurehead is running")
    @is-running?))

get the running figurehead session's state

(defn get-running-figurehead-state
  []
  (let [state (promise)]
    (if (figurehead-is-running?)
      (do
        (let [commands [(build-figurehead-command "--status")]
              timeout 120]
          (execute-root-command :commands commands
                                :timeout timeout
                                :callback? true
                                :buffered? true
                                :on-normal
                                (do
                                  (let [output (str/join " " output)]
                                    (try
                                      (deliver state
                                               (read-string output))
                                      (catch Exception e
                                        (print-stack-trace e)
                                        (deliver state nil)))))
                                :on-error
                                (do
                                  (deliver state nil))
                                :error-message
                                "Cannot access Figurehead running state")))
      (do
        (deliver state nil)))
    @state))
 

REPL helpers

(ns figurehead.ui.helper.repl
  (:use (figurehead.ui su
                       util))
  (:require (neko init
                  [threading :refer [on-ui]]
                  [notify :refer [toast]]))
  (:require (clojure [string :as str]
                     [set :as set]
                     [pprint :refer [pprint]]
                     [stacktrace :refer [print-stack-trace]]))
  (:require [clojure.core.async :as async])
  (:require [clojure.tools.nrepl.server :as nrepl-server]
            (cider.nrepl.middleware apropos
                                    classpath
                                    ;;complete
                                    ;;info
                                    inspect
                                    macroexpand
                                    resource
                                    stacktrace
                                    test
                                    ;;trace)))
(declare start-repl stop-repl)

the sole REPL session to figurehead.ui

(def repl-session
  (atom nil))

A vector containing all CIDER middleware.

(def ^:private cider-middleware
  '[cider.nrepl.middleware.apropos/wrap-apropos
    cider.nrepl.middleware.classpath/wrap-classpath
    ;;cider.nrepl.middleware.complete/wrap-complete
    ;;cider.nrepl.middleware.info/wrap-info
    cider.nrepl.middleware.inspect/wrap-inspect
    cider.nrepl.middleware.macroexpand/wrap-macroexpand
    cider.nrepl.middleware.resource/wrap-resource
    cider.nrepl.middleware.stacktrace/wrap-stacktrace
    cider.nrepl.middleware.test/wrap-test
    ;;cider.nrepl.middleware.trace/wrap-trace
    ])

CIDER's nREPL handler.

(def ^:private cider-nrepl-handler
  (apply nrepl-server/default-handler (map resolve cider-middleware)))

start REPL is there is none

(defn start-repl
  [& {:keys [port]
      :or {port 9999}
      :as args}]
  (when-not @repl-session
    (background-thread
     (reset! repl-session
             (neko.init/start-repl :port port
                                   :handler cider-nrepl-handler))
     ;; set up 'user ns
     (do
       (in-ns 'user)
       (use 'clojure.repl)
       (use 'clojure.pprint)
       (use 'clojure.java.io)
       (require 'clojure.set :as set)
       (use 'neko.doc)
       (use 'neko.debug)))))

stop the sole

(defn stop-repl
  []
  (let [session @repl-session]
    (when session
      (background-thread
       (reset! repl-session nil)
       (nrepl-server/stop-server session)))))
 

widgets helpers

(ns figurehead.ui.helper.widgets
  (:use (figurehead.ui su
                       util)
        (figurehead.ui.helper figurehead))
  (:require (neko [threading :refer [on-ui]]
                  [notify :refer [toast]]))
  (:require (clojure [string :as str]
                     [set :as set]
                     [pprint :refer [pprint]]
                     [stacktrace :refer [print-stack-trace]]))
  (:import (android.widget Switch
                           Button
                           CheckBox
                           EditText
                           TextView
                           ScrollView)
           (android.view View)))
(declare with-widgets set-enabled
         sync-widgets-to-state sync-widgets-to-figurehead
         widgets-to-arg-map widgets-to-figurehead-args
         save-widget-state get-saved-widget-state)

wrap body with widgets tagged bindings

(defmacro with-widgets
  [widgets & body]
  `(let [widgets# ~widgets
         ~'widget-figurehead-switch ^Switch (:figurehead-switch widgets#)
         ~'widget-monitor ^CheckBox (:monitor widgets#)
         ~'widget-verbose ^CheckBox (:verbose widgets#)
         ~'widget-wifi-if ^TextView (:wifi-if widgets#)
         ~'widget-repl-port ^EditText (:repl-port widgets#)
         ~'widget-mastermind-address ^EditText (:mastermind-address widgets#)
         ~'widget-mastermind-port ^EditText (:mastermind-port widgets#)
         ~'widget-extra-args ^EditText (:extra-args widgets#)
         ~'widget-status ^TextView (:status widgets#)
         ~'widget-scroll-status ^ScrollView (:scroll-status widgets#)
         ~'widget-clear-status ^Button (:clear-status widgets#)]
     ~@body))

set enabled status of the widgets

(defn set-enabled
  [widgets enabled]
  (on-ui
   (doseq [[_ ^View widget] widgets]
     (.setEnabled widget enabled))
   ;; special cases
   (with-widgets widgets
     (.setEnabled widget-wifi-if true))))

sync widgets to state

(defn sync-widgets-to-state
  [widgets state]
  (on-ui
   (with-widgets widgets
     (try
       ;; temporarily disable all widgets during state transition
       (set-enabled widgets false)
       (try
         (when-not (nil? (:monitor state))
           (.setChecked widget-monitor
                        (Boolean/parseBoolean ^String (str (:monitor state)))))
         (catch Exception e))
       (try
         (when-not (nil? (:verbose state))
           (.setChecked widget-verbose
                        (Boolean/parseBoolean ^String (str (:verbose state)))))
         (catch Exception e))
       (try
         (when-not (nil? (:nrepl-port state))
           (.setText widget-repl-port
                     ^String
                     (let [nrepl-port ^String (str (:nrepl-port state))]
                       (if nrepl-port nrepl-port ""))))
         (catch Exception e))
       (try
         (when-not (nil? (:mastermind-address state))
           (.setText widget-mastermind-address
                     ^String
                     (let [mastermind-address ^String (str (:mastermind-address state))]
                       (if mastermind-address mastermind-address ""))))
         (catch Exception e))
       (try
         (when-not (nil? (:mastermind-port state))
           (.setText widget-mastermind-port
                     ^String
                     (let [mastermind-port ^String (str (:mastermind-port state))]
                       (if mastermind-port mastermind-port ""))))
         (catch Exception e))
       (try
         (when-not (nil? (:extra-args state))
           (.setText widget-extra-args
                     ^String
                     (let [extra-args ^String (str (:extra-args state))]
                       (if extra-args extra-args ""))))
         (catch Exception e))
       (try
         (when-not (nil? (:is-running? state))
           (.setChecked widget-figurehead-switch
                        (Boolean/parseBoolean ^String (str (:is-running? state)))))
         (catch Exception e))         
       (catch Exception e
         (print-stack-trace e))
       (finally
         ;; enable needed widgets
         (if (.isChecked widget-figurehead-switch)
           (do
             (.setEnabled widget-figurehead-switch true)
             (.setEnabled widget-scroll-status true)
             (.setEnabled widget-status true)
             (.setEnabled widget-clear-status true))
           (do
             (set-enabled widgets true))))))))

the first sync should be from SU figurehead; later can from saved widget state

(def ^:private first-sync?
  (atom true))

sync widgets status to figurehead

(defn sync-widgets-to-figurehead
  [widgets]
  (background-thread
   (let [saved-widget-state (get-saved-widget-state)]
     (sync-widgets-to-state widgets
                            (if (and saved-widget-state
                                     ;; force to sync at least once
                                     (not @first-sync?))
                              saved-widget-state
                              (do
                                (let [state (get-running-figurehead-state)
                                      is-running? (if (:is-running? state) true false)]
                                  (assoc (:state state)
                                    :is-running? is-running?))
                                (reset! first-sync? false)))))))

convert widgets to Figurehead argument map

(defn widgets-to-arg-map
  [widgets]
  (let [args (atom {})]
    (with-widgets widgets
      (try
        (let [checked (.isChecked widget-monitor)]
          (swap! args assoc :monitor checked))
        (catch Exception e
          (print-stack-trace e)))
      (try
        (let [checked (.isChecked widget-verbose)]
          (swap! args assoc :verbose checked))
        (catch Exception e
          (print-stack-trace e)))
      (try
        (let [port (int (read-string (.. widget-repl-port getText toString trim)))]
          (if (< 0 port 65536)
            (do
              (swap! args assoc :repl-port port))
            (do
              (on-ui
               (.setText widget-repl-port "")))))
        (catch Exception e
          (print-stack-trace e)
          (on-ui
           (.setText widget-repl-port ""))))
      (try
        (let [text (read-string (str "\""
                                     (.. widget-mastermind-address getText toString trim)
                                     "\""))]
          (when-not (empty? text)
            (swap! args assoc :mastermind-address text)))
        (catch Exception e
          (print-stack-trace e)
          (on-ui
           (.setText widget-mastermind-address ""))))
      (try
        (let [port (int (read-string (.. widget-mastermind-port getText toString trim)))]
          (if (< 0 port 65536)
            (do
              (swap! args assoc :mastermind-port port))
            (do
              (on-ui
               (.setText widget-mastermind-port "")))))
        (catch Exception e
          (print-stack-trace e)
          (on-ui
           (.setText widget-mastermind-port ""))))
      (try
        (let [text (read-string (str "\""
                                     (.. widget-extra-args getText toString trim)
                                     "\""))]
          (when-not (empty? text)
            (swap! args assoc :extra-args text)))
        (catch Exception e
          (print-stack-trace e)
          (on-ui
           (.setText widget-extra-args "")))))
    @args))

construct figurehead command-line args from widgets

(defn widgets-to-figurehead-args
  [widgets]
  (let [args (atom [])
        arg-map (widgets-to-arg-map widgets)
        monitor (:monitor arg-map)
        verbose (:verbose arg-map)
        repl-port (:repl-port arg-map)
        mastermind-address (:mastermind-address arg-map)
        mastermind-port (:mastermind-port arg-map)
        extra-args (:extra-args arg-map)]
    (when monitor
      (swap! args conj
             "--monitor"))
    (when verbose
      (swap! args conj
             "--verbose"))
    (when repl-port
      (swap! args conj
             (str "--nrepl-port " repl-port)))
    (when mastermind-address
      (swap! args conj
             (str "--mastermind-address " mastermind-address)))
    (when mastermind-port
      (swap! args conj
             (str "--mastermind-port " mastermind-port)))
    (when extra-args
      (swap! args conj
             (str extra-args)))
    @args))

the saved widget state

(def ^:private saved-widget-state
  (atom {}))
(defn save-widget-state
  [widgets]
  (with-widgets widgets
    (try
      (swap! saved-widget-state
             assoc :monitor (.isChecked widget-monitor))
      (swap! saved-widget-state
             assoc :verbose (.isChecked widget-verbose))
      (swap! saved-widget-state
             assoc :nrepl-port (str (.getText widget-repl-port)))
      (swap! saved-widget-state
             assoc :mastermind-address (str (.getText widget-mastermind-address)))
      (swap! saved-widget-state
             assoc :mastermind-port (str (.getText widget-mastermind-port)))
      (swap! saved-widget-state
             assoc :extra-args (str (.getText widget-extra-args)))
      (swap! saved-widget-state
             assoc :is-running? (.isChecked widget-figurehead-switch))      
      (catch Exception e
        (reset! saved-widget-state nil)))))

obtain the saved widget state

(defn get-saved-widget-state
  []
  @saved-widget-state)
 
(ns figurehead.ui.main
  (:use (figurehead.ui su
                       util)
        (figurehead.ui.helper figurehead
                              widgets))
  (:require (neko [activity :refer [defactivity
                                    set-content-view!
                                    with-activity]]
                  [notify :refer [toast]]
                  [threading :refer [on-ui]]
                  [find-view :refer [find-view]]
                  log)
            (neko.listeners [view :refer [on-click]]))
  (:require (clojure [string :as str]
                     [pprint :refer [pprint]]))
  (:require [clojure.stacktrace :refer [print-stack-trace]])
  (:import (android.app Activity)
           (android.widget Switch
                           Button
                           CheckBox
                           EditText
                           TextView
                           ScrollView)
           (android.view View)
           (android.content Context))
  (:import (android.net.wifi WifiManager)
           (java.net InetAddress)
           (java.nio ByteOrder)
           (java.math BigInteger))
  (:import (java.util List))
  (:import (org.apache.commons.io FilenameUtils))
  (:import (figurehead.ui R$layout
                          R$id))
  (:import eu.chainfire.libsuperuser.Shell$Interactive))
(declare update-wifi-if)

all the widgets on this activity

(def widgets
  (atom nil))
(defactivity figurehead.ui.main
  :on-create
  (fn [^Activity this bundle]
    (do
      ;; UI initialization
      (on-ui
       (set-content-view! this
                          R$layout/main))
      (with-activity this
        (reset! widgets
                {:figurehead-switch  ^Switch (find-view R$id/figurehead_switch)
                 :monitor ^CheckBox (find-view R$id/monitor)
                 :verbose ^CheckBox (find-view R$id/verbose)
                 :wifi-if ^TextView (find-view R$id/wifi_if)
                 :repl-port ^EditText (find-view R$id/repl_port)
                 :mastermind-address ^EditText (find-view R$id/mastermind_address)
                 :mastermind-port ^EditText (find-view R$id/mastermind_port)
                 :extra-args ^EditText (find-view R$id/extra_args)
                 :scroll-status ^ScrollView (find-view R$id/scroll_status)
                 :status ^TextView (find-view R$id/status)
                 :clear-status ^Button (find-view R$id/clear_status)})))
    (set-app-info-entry :figurehead-script (promise))
    (if (su?)
      (do
        (try
          (when-not (get-app-info-entry :apk-path)
            (set-app-info-entry :apk-path (get-figurehead-apk-path this)))
          (let [apk-path (get-app-info-entry :apk-path)]
            (if apk-path
              (do
                (let [path (FilenameUtils/getFullPath apk-path)
                      figurehead-script "/system/bin/figurehead"]
                  (let [commands [
                                  ;; http://stackoverflow.com/a/13366444 
                                  (str "mount -o rw,remount /system")
                                  ;; create the script in one write
                                  (str "echo \
                                       (str/join "\\n"
                                                 ["# bootstrapping Figurehead"
                                                  (str "export CLASSPATH=" apk-path)
                                                  (str "exec app_process "
                                                       path
                                                       " figurehead.main \\\"\\$@\\\)])
                                       "\" > "
                                       figurehead-script)
                                  (str "chmod 700 "
                                       figurehead-script)]
                        ;; factor in the time it takes for user to authorize SU 
                        timeout 120]
                    (execute-root-command :commands commands
                                          :timeout timeout
                                          :callback? true
                                          :buffered? false
                                          :on-normal
                                          (do
                                            (deliver (get-app-info-entry :figurehead-script)
                                                     figurehead-script))
                                          :on-error
                                          (do
                                            (deliver (get-app-info-entry :figurehead-script)
                                                     nil))
                                          :error-message
                                          (str/join " "
                                                    ["Cannot create"
                                                     figurehead-script])))))
              (do
                (on-ui
                 (toast "Figurehead cannot find its own APK."))
                (deliver (get-app-info-entry :figurehead-script)
                         nil))))
          (catch Exception e
            (print-stack-trace e))))
      (do
        ;; no SU
        (on-ui
         (toast "Superuser needed but not available!")))))
  :on-resume
  (fn [^Activity this]
    (let [widgets @widgets
          context this]
      (update-wifi-if context
                      widgets)
      (with-widgets widgets
        (sync-widgets-to-figurehead widgets)
        (on-ui
         (.setOnClickListener
          widget-clear-status
          (on-click
           (update-wifi-if context
                           widgets)
           ;; clear text
           (.setText widget-status )))
         (.setOnClickListener
          widget-wifi-if
          (on-click
           (update-wifi-if context
                           widgets)))
         (.setOnCheckedChangeListener
          widget-figurehead-switch
          (proxy [android.widget.CompoundButton$OnCheckedChangeListener] []
            (onCheckedChanged [^android.widget.CompoundButton button-view
                               is-checked?]
              (update-wifi-if context
                              widgets)
              (background-looper-thread
               (let [figurehead-is-running? (figurehead-is-running?)]
                 (when (not= is-checked? figurehead-is-running?)
                   (on-ui
                    ;; temporarily disable widgets during state transition
                    (set-enabled widgets false)
                    ;; allow user to change her mind
                    (.setEnabled widget-figurehead-switch true))
                   (if is-checked?
                     (do
                       ;; turn on
                       (let [figurehead-args (into ["--replace"]
                                                   (widgets-to-figurehead-args widgets))
                             commands [(apply build-figurehead-command figurehead-args)]
                             ;; this is supposed to be a long running command
                             timeout 0]
                         (execute-root-command :commands commands
                                               :timeout timeout
                                               :callback? true
                                               :buffered? false
                                               :command-line-listener
                                               (do
                                                 (on-ui
                                                  (.append widget-status
                                                           (with-out-str (println line)))
                                                  (.post widget-scroll-status
                                                         #(.fullScroll widget-scroll-status
                                                                       View/FOCUS_DOWN))))
                                               :on-normal
                                               (do
                                                 ;; Figurehead returns
                                                 (set-enabled widgets true)
                                                 (on-ui
                                                  (.setChecked widget-figurehead-switch
                                                               false)))
                                               :on-error
                                               (do
                                                 (.setEnabled widget-figurehead-switch true)
                                                 (.setEnabled widget-scroll-status true)
                                                 (.setEnabled widget-status true)
                                                 (.setEnabled widget-clear-status true))
                                               :error-message
                                               "Cannot start Figurehead"))
                       ;; enable needed widgets
                       (on-ui
                        (do
                          (.setEnabled widget-figurehead-switch true)
                          (.setEnabled widget-scroll-status true)
                          (.setEnabled widget-status true)
                          (.setEnabled widget-clear-status true)))) 
                     (do
                       ;; turn off
                       (let [commands [(build-figurehead-command "--kill")]
                             timeout 120]
                         (execute-root-command :commands commands
                                               :timeout timeout
                                               :callback? true
                                               :buffered? false
                                               :on-normal
                                               (do
                                                 (on-ui
                                                  (set-enabled widgets true)))
                                               :error-message
                                               "Cannot turn off Figurehead"))))))))))))))
  :on-pause
  (fn [^Activity this]
    (let [widgets @widgets]
      (with-widgets widgets
        (save-widget-state widgets))))
  :on-stop
  (fn [^Activity this]
    (let [widgets @widgets]
      (with-widgets widgets
        (save-widget-state widgets))))
  :on-destroy
  (fn [^Activity this]
    (let [widgets @widgets]
      (with-widgets widgets
        (save-widget-state widgets)))))

update wifi-if widget based on current WiFi address

http://stackoverflow.com/a/18638588

(defn update-wifi-if
  [^Context context widgets]
  (with-widgets widgets
    (let [wifi-manager ^WifiManager (.getSystemService context
                                                       Context/WIFI_SERVICE)]
      (if wifi-manager
        (let [ip (.. wifi-manager
                     getConnectionInfo
                     getIpAddress)
              ip-byte-array (.. (BigInteger/valueOf (if (= (ByteOrder/nativeOrder)
                                                           ByteOrder/BIG_ENDIAN)
                                                      ip
                                                      (Integer/reverseBytes ip)))
                                toByteArray)]
          (try
            (let [ip (.. (InetAddress/getByAddress ip-byte-array)
                         getHostAddress)]
              (on-ui
               (.setText widget-wifi-if
                         ip)))
            (catch Exception e
              (print-stack-trace e)
              (on-ui
               (.setText widget-wifi-if
                         "")))))
        (do
          (on-ui
           (.setText widget-wifi-if
                     "")))))))
 
(ns figurehead.ui.su
  (:use (figurehead.ui util))
  (:require (neko [notify :refer [toast]]
                  [threading :refer [on-ui]]
                  [log :as log]))
  (:require (clojure [string :as str]
                     [stacktrace :refer [print-stack-trace]]))
  (:import (android.content Context))
  (:import (java.util Collection
                      ArrayList
                      List))
  (:import eu.chainfire.libsuperuser.Shell
           eu.chainfire.libsuperuser.Shell$SU
           eu.chainfire.libsuperuser.Shell$SH
           eu.chainfire.libsuperuser.Shell$Interactive
           eu.chainfire.libsuperuser.Shell$Builder
           eu.chainfire.libsuperuser.Shell$OnCommandLineListener
           eu.chainfire.libsuperuser.Shell$OnCommandResultListener))
(declare su?
         su sh
         open-root-shell
         execute-root-command)

check whether SuperUser is available

(defn su?
  []
  (Shell$SU/available))

run cmds with Super User

(defn su
  [& commands]
  (when commands
    (Shell$SU/run (ArrayList. ^Collection commands))))

run cmds with SHell

(defn sh
  [& commands]
  (when commands
    (Shell$SH/run (ArrayList. ^Collection commands))))

open a new root shell

(defmacro open-root-shell
  [&
   {:keys [timeout
           want-stderr?
           minimal-logging?
           callback?
           command-result-listener
           on-shell-running
           on-watchdog-exit
           on-shell-died
           on-shell-exec-failed
           on-shell-wrong-uid
           on-default
           on-error
           on-normal
           error-message]
    :or {timeout 0
         want-stderr? false
         minimal-logging? true
         callback? false
         error-message "open-root-shell"}
    :as args}]
  `(let [timeout# ~timeout
         want-stderr?# ~want-stderr?
         minimal-logging?# ~minimal-logging?
         ~'error-message ~error-message
         su# (promise)]
     (background-looper-thread
      (deliver su#
               (.. (Shell$Builder.)
                   (useSU)
                   (setAutoHandler true)
                   (setWatchdogTimeout timeout#)
                   (setWantSTDERR want-stderr?#)
                   (setMinimalLogging minimal-logging?#)
                   (open
                    ~(when callback?
                       `(proxy [Shell$OnCommandResultListener] []
                          (onCommandResult [~'command-code
                                            ~'exit-code
                                            ^List ~'output]
                            ~command-result-listener
                            (if (>= ~'exit-code 0)
                              (do
                                ;; normal
                                ~on-normal)
                              (do
                                ;; error
                                (let [error# (str ~'error-message
                                                  " "
                                                  ~'exit-code)]
                                  (neko.threading/on-ui
                                   (neko.notify/toast error#))
                                  (neko.log/e error#))
                                ~on-error))
                            (case ~'exit-code
                              Shell$OnCommandResultListener/SHELL_RUNNING
                              (do
                                ~on-shell-running)
                              Shell$OnCommandResultListener/WATCHDOG_EXIT
                              (do
                                (let [error# (str ~'error-message
                                                  " (timeout)")]
                                  (neko.threading/on-ui
                                   (neko.notify/toast error#))
                                  (neko.log/e error#))
                                ~on-watchdog-exit)
                              Shell$OnCommandResultListener/SHELL_DIED
                              (do
                                (let [error# (str ~'error-message
                                                  " (died)")]
                                  (neko.threading/on-ui
                                   (neko.notify/toast error#))
                                  (neko.log/e error#))
                                ~on-shell-died)
                              Shell$OnCommandResultListener/SHELL_EXEC_FAILED
                              (do
                                (let [error# (str ~'error-message
                                                  " (exec failed)")]
                                  (neko.threading/on-ui
                                   (neko.notify/toast error#))
                                  (neko.log/e error#))
                                ~on-shell-exec-failed)
                              Shell$OnCommandResultListener/SHELL_WRONG_UID
                              (do
                                (let [error# (str ~'error-message
                                                  " (wrong uid)")]
                                  (neko.threading/on-ui
                                   (neko.notify/toast error#))
                                  (neko.log/e error#))
                                ~on-shell-wrong-uid)
                              ;; default clause
                              ;; should not reach here
                              (do
                                ~on-default)))))))))
     @su#))

execute root command

(defmacro execute-root-command
  [&
   {:keys [commands
           timeout
           command-code
           callback?
           buffered?
           command-result-listener
           command-line-listener
           on-shell-running
           on-watchdog-exit
           on-shell-died
           on-shell-exec-failed
           on-shell-wrong-uid
           on-default
           on-error
           on-normal
           error-message]
    :or {commands []
         timeout 0
         command-code 0
         callback? false
         buffered? true
         error-message "execute-root-command"}
    :as args}]
  `(background-looper-thread
    (try
      (let [commands# ~commands
            timeout# ~timeout
            ~'command-code ~command-code
            ~'error-message ~error-message]
        (let [^Shell$Interactive
              ~'su-instance (open-root-shell
                             :timeout timeout#)]
          (try
            (let [commands# (if (sequential? commands#)
                              commands#
                              [commands#])]
              (doseq [command# commands#]
                (let [~'command (str command#)]
                  (let [info# (str "SU: " ~'command)]
                    (log/i info#))
                  ~(if callback?
                     (do
                       (if buffered?
                         (do
                           ;; process buffered output
                           `(.addCommand ^Shell$Interactive
                                         ~'su-instance
                                         ^String
                                         ~'command
                                         ~'command-code
                                         (proxy [Shell$OnCommandResultListener] []
                                           (onCommandResult [~'command-code
                                                             ~'exit-code
                                                             ^List ~'output]
                                             ~command-result-listener
                                             (if (>= ~'exit-code 0)
                                               (do
                                                 ;; normal
                                                 ~on-normal)
                                               (do
                                                 ;; error
                                                 (let [error# (str ~'error-message
                                                                   " "
                                                                   ~'exit-code)]
                                                   (neko.threading/on-ui
                                                    (neko.notify/toast error#))
                                                   (neko.log/e error#))
                                                 ~on-error))
                                             (case ~'exit-code
                                               Shell$OnCommandResultListener/SHELL_RUNNING
                                               (do
                                                 ~on-shell-running)
                                               Shell$OnCommandResultListener/WATCHDOG_EXIT
                                               (do
                                                 (let [error# (str ~'error-message
                                                                   " (timeout)")]
                                                   (neko.threading/on-ui
                                                    (neko.notify/toast error#))
                                                   (neko.log/e error#))
                                                 ~on-watchdog-exit)
                                               Shell$OnCommandResultListener/SHELL_DIED
                                               (do
                                                 (let [error# (str ~'error-message
                                                                   " (died)")]
                                                   (neko.threading/on-ui
                                                    (neko.notify/toast error#))
                                                   (neko.log/e error#))
                                                 ~on-shell-died)
                                               Shell$OnCommandResultListener/SHELL_EXEC_FAILED
                                               (do
                                                 (let [error# (str ~'error-message
                                                                   " (exec failed)")]
                                                   (neko.threading/on-ui
                                                    (neko.notify/toast error#))
                                                   (neko.log/e error#))
                                                 ~on-shell-exec-failed)
                                               Shell$OnCommandResultListener/SHELL_WRONG_UID
                                               (do
                                                 (let [error# (str ~'error-message
                                                                   " (wrong uid)")]
                                                   (neko.threading/on-ui
                                                    (neko.notify/toast error#))
                                                   (neko.log/e error#))
                                                 ~on-shell-wrong-uid)
                                               ;; default clause
                                               ;; should not reach here
                                               (do
                                                 ~on-default))))))
                         (do
                           ;; process output line by line
                           `(.addCommand ^Shell$Interactive
                                         ~'su-instance
                                         ^String
                                         ~'command
                                         ~'command-code
                                         (proxy [Shell$OnCommandLineListener] []
                                           (onLine [^String ~'line]
                                             ~command-line-listener)
                                           (onCommandResult [~'command-code
                                                             ~'exit-code]
                                             ~command-result-listener
                                             (if (>= ~'exit-code 0)
                                               (do
                                                 ;; normal
                                                 ~on-normal)
                                               (do
                                                 ;; error
                                                 (let [error# (str ~'error-message
                                                                   " "
                                                                   ~'exit-code)]
                                                   (neko.threading/on-ui
                                                    (neko.notify/toast error#))
                                                   (neko.log/e error#))
                                                 ~on-error))
                                             (case ~'exit-code
                                               Shell$OnCommandLineListener/SHELL_RUNNING
                                               (do
                                                 ~on-shell-running)
                                               Shell$OnCommandLineListener/WATCHDOG_EXIT
                                               (do
                                                 (let [error# (str ~'error-message
                                                                   " (timeout)")]
                                                   (neko.threading/on-ui
                                                    (neko.notify/toast error#))
                                                   (neko.log/e error#))
                                                 ~on-watchdog-exit)
                                               Shell$OnCommandLineListener/SHELL_DIED
                                               (do
                                                 (let [error# (str ~'error-message
                                                                   " (died)")]
                                                   (neko.threading/on-ui
                                                    (neko.notify/toast error#))
                                                   (neko.log/e error#))
                                                 ~on-shell-died)
                                               Shell$OnCommandLineListener/SHELL_EXEC_FAILED
                                               (do
                                                 (let [error# (str ~'error-message
                                                                   " (exec failed)")]
                                                   (neko.threading/on-ui
                                                    (neko.notify/toast error#))
                                                   (neko.log/e error#))
                                                 ~on-shell-exec-failed)
                                               Shell$OnCommandLineListener/SHELL_WRONG_UID
                                               (do
                                                 (let [error# (str ~'error-message
                                                                   " (wrong uid)")]
                                                   (neko.threading/on-ui
                                                    (neko.notify/toast error#))
                                                   (neko.log/e error#))
                                                 ~on-shell-wrong-uid)
                                               ;; default clause
                                               ;; should not reach here
                                               (do
                                                 ~on-default))))))))
                     (do
                       `(.addCommand ^Shell$Interactive
                                     ~'su-instance
                                     ^String
                                     ~'command))))))
            (finally
              (.close ^Shell$Interactive
                      ~'su-instance)))))
      (catch Exception e#
        (print-stack-trace e#)))))
 

utilities

(ns figurehead.ui.util
  (:require (clojure [string :as str]
                     [set :as set])))
(declare
 ;; threading
 background-thread background-looper-thread
 ;; app-info
 app-info
 get-app-info-entry update-app-info-entry
 set-app-info-entry unset-app-info-entry)

threading

run the body in a background thread

(defmacro background-thread
  [& body]
  `(let [thread# (Thread.
                  (fn []
                    (android.os.Process/setThreadPriority
                     (android.os.Process/myTid)
                     android.os.Process/THREAD_PRIORITY_BACKGROUND)
                    ~@body))]
     (.start thread#)
     thread#))

run the body in a background thread with a Looper

(defmacro background-looper-thread
  [& body]
  `(let [looper# (promise)
         thread# (Thread.
                  (fn []
                    (android.os.Looper/prepare)
                    (deliver looper# (android.os.Looper/myLooper))
                    (android.os.Process/setThreadPriority
                     (android.os.Process/myTid)
                     android.os.Process/THREAD_PRIORITY_BACKGROUND)
                    ~@body
                    (android.os.Looper/loop)))]
     (.start thread#)
     looper#))

app info

app info

(def app-info
  (atom {}))

get app info entry with

(defn get-app-info-entry
  [name]
  (get @app-info name))

update app info entry with to (apply f args)

(defn update-app-info-entry
  [name f & args]
  (apply swap! app-info
         update-in [name] f args))

set app info entry with to

(defn set-app-info-entry
  [name value]
  (swap! app-info
         assoc name value))

unset app info entry with

(defn unset-app-info-entry
  [name]
  (swap! app-info
         dissoc name))
 
(ns figurehead.util.init
  (:require (figurehead.util [services
                              :as services
                              :refer [register-service]]))
  (:import (android.os ServiceManager
                       IUserManager
                       IUserManager$Stub)
           (android.app ActivityManagerNative
                        IActivityManager)
           (android.content.pm IPackageManager
                               IPackageManager$Stub)))
(declare init)

register services

(defn- register-services
  []
  (register-service :activity-manager
                    ^IActivityManager #(ActivityManagerNative/getDefault))
  (register-service :user-manager
                    ^IUserManager #(->>
                                    (ServiceManager/getService "user")
                                    (IUserManager$Stub/asInterface)))
  (register-service :package-manager
                    ^IPackageManager #(->> 
                                       (ServiceManager/getService "package") 
                                       (IPackageManager$Stub/asInterface))))

initialization

(defn init
  []
  (register-services))
 
(ns figurehead.util.routines)
(declare vector-to-map)

convert [:key1 val1 :key2 val2 ...] into {:key1 val1, key2 val2, ...}

(defn vector-to-map
  [v]
  (into {} (map vec (partition 2 v))))
 
(ns figurehead.util.services
  (:require (core [bus :as bus])))
(declare policy services
         get-service list-service register-service)

internal policy of service procedures

(def policy
  (atom
   {:register-retry-interval 500}))

map from service tag to its (delayed) instance

(def services
  (atom {}))

get service by tag

(defn get-service 
  [tag]
  (when-let [service (tag @services)]
    ;; get the (delayed) service
    @service))

get tags of all services

(defn list-services 
  []
  (keys @services))

register a service with tag by (obtain-fn)

(defn register-service
  [tag obtain-fn]
  (swap! services assoc tag
         (delay
          (loop [h (obtain-fn)]
            (if h
              h
              (do
                (bus/say!! :error (str "obtaining " (name tag) "..."))
                (Thread/sleep (:register-retry-interval @policy))
                (recur (obtain-fn))))))))
 

work with a unique Figurehead instance

(ns figurehead.util.unique-instance
  (:require (core [init :as init]
                  [state :as state]
                  [bus :as bus]
                  [plugin :as plugin]))
  (:require (figurehead.api.os [util :as os-util]))
  (:import (android.os SystemProperties)))
(declare
 ;; test whether running already
 is-running?
 ;; existing instance
 kill-existing-instance replace-existing-instance keep-existing-instance
 ;; pid
 get-pid set-pid
 ;; meta data
 meta-data
 get-meta-data-entry-sysprop
 get-meta-data-entry set-meta-data-entry unset-meta-data-entry
 get-meta-data unset-meta-data)
(def ^:private defaults
  (atom
   {
    :sysprop-pid "figurehead.pid"
    :sysprop-meta-data "figurehead.meta-data"
    :exit-code-on-existing 19
    }))

test whether running already

test whether a Figurehead instance is already running

(defn is-running?
  []
  (let [sys-pid (get-pid)]
    (os-util/test-process {:pid sys-pid})))

existing instance

kill the existing Figurehead instance

(defn kill-existing-instance
  []
  (let [sys-pid (get-pid)]
    (when (and (not= sys-pid 0)
               (is-running?))
      (os-util/kill-process {:pid sys-pid})
      (set-pid 0)
      (unset-meta-data))))

replace the existing Figurehead instance with the current oneexit if there is an existing Figurehead instance, continue otherwise

(let [run (fn []
            (let [cur-pid (os-util/get-my-pid {})] 
              (set-pid cur-pid)
              (.addShutdownHook ^Runtime (Runtime/getRuntime)
                                (Thread. #(let [sys-pid (get-pid)]
                                            (when (= sys-pid cur-pid)
                                              (set-pid 0)
                                              (unset-meta-data)))))))]
  (defn replace-existing-instance
    []
    (kill-existing-instance)
    (run))
  (defn keep-existing-instance
    []
    (if (is-running?)
      (System/exit (:exit-code-on-existing @defaults))
      (run))))

pid

get pid of the unique instance

(defn get-pid
  []
  (let [sysprop-pid (:sysprop-pid @defaults)
        pid (os-util/get-system-property {:name sysprop-pid
                                          :def 0
                                          :int? true})]
    pid))

set pid of the unique instance

(defn set-pid
  [pid]
  (let [sysprop-pid (:sysprop-pid @defaults)]
    (os-util/set-system-property {:name sysprop-pid
                                  :value pid})))

meta data

(def meta-data
  (atom {}))

get meta data entry's sysprop

(defn get-meta-data-entry-sysprop
  [entry-name]
  (str "figurehead." (cond (keyword? entry-name)
                           (name entry-name)
                           :else
                           name)))

get meta data entry

(defn get-meta-data-entry
  [name]
  (get @meta-data name))

register meta data entry

(defn register-meta-data-entry
  [name]
  (swap! meta-data
         assoc name nil))

set meta data entry

(defn set-meta-data-entry
  [name value]
  (let [sysprop (get-meta-data-entry-sysprop name)]
    (os-util/set-system-property {:name sysprop
                                  :value value})
    (swap! meta-data
           assoc name value)))

unset meta data entry

(defn unset-meta-data-entry
  [name]
  (let [sysprop (get-meta-data-entry-sysprop name)]
    (swap! meta-data
           dissoc name)
    (os-util/set-system-property {:name sysprop
                                  :value ""})))

get all meta data of the unique instance

(defn get-meta-data
  []
  (into {}
        (for [name (keys @meta-data)]
          (let [sysprop (get-meta-data-entry-sysprop name)
                entry (os-util/get-system-property {:name sysprop})]
            [name entry]))))

unset all meta data of the unique instance

(defn unset-meta-data
  []
  (doseq [name (keys @meta-data)]
    (let [sysprop (get-meta-data-entry-sysprop name)]
      (os-util/set-system-property {:name sysprop
                                    :value ""}))))