Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

catch up after 5 months :)

  • Loading branch information...
commit afb230d76bd9e16d5dc03a45799860d99f3cfe87 1 parent d4dc078
Zoran Tomičić authored
5 src/ringmon/api.clj
View
@@ -1,11 +1,10 @@
(ns ringmon.api
+ "User level nREPL scripts should call only ringMon functions from this namespace
+ to insure backwards compatibility."
(:require
[ringmon.nrepl :as repl]
[ringmon.monitor :as mon]))
-"User nREPL scripts should call only ringMon functions from this namespace
- to insure backwards compatibility"
-
(defn set-nick
"Change your chat nick. Return the old one if succesful, nil otherwise."
[nick]
2  src/ringmon/cookies.clj
View
@@ -32,7 +32,7 @@
v
default))))
-(defn noir-cookies [handler]
+(defn- noir-cookies [handler]
(fn [request]
(binding [*cur-cookies* (:cookies request)
*new-cookies* (atom {})]
111 src/ringmon/monitor.clj
View
@@ -42,52 +42,49 @@
:auth-fn nil})) ; authorisation callback, checked only if :disabled is true
; will be passed a Ring request, return true if Ok
-(def cpu-load (atom 0.0))
-(def ajax-reqs-ps (atom 0.0)) ; ajax requests per second
-(def ajax-reqs-tot (atom 0)) ; total requests
+(def cpu-load (atom 0.0)) ; CPU load (2 seconds average)
+(def ajax-reqs-ps (atom 0.0)) ; ajax requests per second
+(def ajax-reqs-tot (atom 0)) ; total requests
(def ^:const sample-interval 2000) ; msec
-(defn get-process-nanos
+(defn- get-process-nanos
[]
(jmx/read "java.lang:type=OperatingSystem" :ProcessCpuTime))
-(defn calc-cpu-load
+(defn- calc-cpu-load
[cpu-time clock-time]
(/ (* 100.0 cpu-time) clock-time))
-(defn data-sampler
+(defn- data-sampler
[]
-
(loop [process-nanos (get-process-nanos)
real-nanos (System/nanoTime)
ajax-reqs @ajax-reqs-tot
old-process-nanos 0
old-real-nanos 0
old-ajax-reqs 0]
-
- (Thread/sleep sample-interval)
- (reset! cpu-load
- (calc-cpu-load
- (- process-nanos old-process-nanos)
- (- real-nanos old-real-nanos)))
-
- (reset! ajax-reqs-ps
- (/ (- ajax-reqs old-ajax-reqs) 2.0))
- (repl/check-sessions) ; sessions house-keeping
- (recur (get-process-nanos)
- (System/nanoTime)
- @ajax-reqs-tot
- process-nanos
- real-nanos
- ajax-reqs)))
+ (Thread/sleep sample-interval)
+ (reset! cpu-load
+ (calc-cpu-load
+ (- process-nanos old-process-nanos)
+ (- real-nanos old-real-nanos)))
+ (reset! ajax-reqs-ps
+ (/ (- ajax-reqs old-ajax-reqs) 2.0))
+ (repl/check-sessions) ; sessions house-keeping
+ (recur (get-process-nanos)
+ (System/nanoTime)
+ @ajax-reqs-tot
+ process-nanos
+ real-nanos
+ ajax-reqs)))
; based on https://github.com/mikejs/ring-gzip-middleware.git
; just converted to use clojure.java.io from Clojure 1.3
-(defn gzipped-response
+(defn- gzipped-response
[resp]
(let [body (resp :body)
bout (java.io.ByteArrayOutputStream.)
- out (java.util.zip.GZIPOutputStream. bout)
+ out (java.util.zip.GZIPOutputStream. bout)
resp (assoc-in resp [:headers "content-encoding"] "gzip")]
(clojure.java.io/copy body out)
(.close out)
@@ -95,7 +92,7 @@
(.close body))
(assoc resp :body (java.io.ByteArrayInputStream. (.toByteArray bout)))))
-(defn wrap-gzip
+(defn- wrap-gzip
[handler]
(fn [req]
(let [{body :body
@@ -115,18 +112,19 @@
resp))
resp))))
-(defn extract-config
+(defn- extract-config
+ "Extract browser relevant configuration data from @the-cfg."
[]
(select-keys @the-cfg [:fast-poll
:norm-poll
:parent-url
:lein-webrepl]))
-;; Can't serialize JMX entries without this
+;; Can't serialize JMX entries without this on OpenJDK7
(defn- object-name-str [x]
(update-in x [:ObjectName] str))
-(defn get-mon-data
+(defn- get-mon-data
[sname client-ip ring-sess]
(let [os (jmx/mbean "java.lang:type=OperatingSystem")
mem (jmx/mbean "java.lang:type=Memory")
@@ -155,24 +153,24 @@
:_chatMsg msg
:_config (extract-config)}))
-(defn do-jvm-gc
+(defn- do-jvm-gc
[]
(jmx/invoke "java.lang:type=Memory" :gc)
{:resp "ok"})
-(defn send-chat
+(defn- send-chat
[sname msg to client-ip ring-sess]
(repl/send-chat-msg sname msg to client-ip ring-sess )
{:resp "ok"})
-(defn set-chat-nick
+(defn- set-chat-nick
[sname nick client-ip ring-sess]
(let [old-nick (repl/set-chat-nick sname nick client-ip ring-sess)]
{:resp "ok" :old-nick old-nick}))
(def ringmon-host-url (atom nil))
-(defn gen-invite
+(defn- gen-invite
[sname to from msg sid client-ip]
(let [[name invite-pars]
(repl/register-invite sname to from msg client-ip)]
@@ -183,26 +181,36 @@
"/ringmon/monview.html"
invite-pars)}))
-(defn check-for-invite
- [params ring-sess]
- )
+(defn- check-for-invite
+ [params ring-sess])
-(defn get-host-url
+(defn- get-host-url
+ "Extract host URK from Ring request."
[req]
(let [srv (:server-name req)
port (:server-port req)
tp (name(:scheme req))]
- (str tp "://" srv ":" port)))
-
-(defn init-module
+ (when (= tp "http")
+ (if (= port 80)
+ (str tp "://" srv) ; port 80 is default
+ (str tp "://" srv ":" port)))
+ (when (= tp "https")
+ (if (= port 443)
+ (str tp "://" srv) ; port 443 is default
+ (str tp "://" srv ":" port)))))
+
+(defn- init-module
+ "Called upon first AJAX request."
[]
(.start (Thread. data-sampler))
(repl/set-mirror-cfg @the-cfg)
(repl/parse-lein-project))
-(def sampler-started (atom 0))
+(def ^{:doc "Flag to nake sure that init-module is called only once at the start."}
+ sampler-started (atom 0))
-(defn decode-cmd
+(defn- decode-cmd
+ "Command dispatcher."
[params client-ip ring-sess]
(when (compare-and-set! sampler-started 0 1)
(init-module))
@@ -227,13 +235,14 @@
client-ip ring-sess)
{:resp "bad-cmd"})))
-(defn ajax
+(defn- ajax
+ "AJAX processor of client commands. Returns a JSON data response."
[params client-ip ring-sess]
(let [reply (decode-cmd params client-ip ring-sess)
j-reply (json/generate-string reply)]
j-reply))
-(defn get-client-ip
+(defn- get-client-ip
[req]
(let [hdrs (:headers req)
xfwd (get hdrs "x-forwarded-for")]
@@ -241,12 +250,15 @@
(first (string/split xfwd #","))
(:remote-addr req))))
-(defn ringmon-req?
+(defn- ringmon-req?
+ "Check if URI refers to ringMon stuff."
[uri]
(or (= uri "/ringmon/command")
(= uri "/ringmon/monview.html")))
-(defn ringmon-allowed?
+(defn- ringmon-allowed?
+"Performs 2 level of security checking. First by white/black set filter,
+ and then by using autorisation callback, if required."
[req client-ip]
(when (sec/check-ip client-ip)
(if (:disabled @the-cfg)
@@ -257,14 +269,14 @@
nil)
true)))
-(defn wrap-ajax
+(defn- wrap-ajax
[handler]
(fn [req]
(let [uri (:uri req)]
(if (ringmon-req? uri)
(let [client-ip (get-client-ip req)]
(if (ringmon-allowed? req client-ip)
- (let [params (clojure.walk/keywordize-keys (:query-params req))
+ (let [params (clojure.walk/keywordize-keys (:query-params req))
ring-sess (get
(get
(:cookies req) "ring-session") :value)]
@@ -279,7 +291,7 @@
(response/response "Not allowed")))
(handler req)))))
-(defn wrap-pass-through
+(defn- wrap-pass-through
[handler]
(fn [req]
(let [uri (:uri req)]
@@ -295,7 +307,6 @@
(if (:local-repl @the-cfg)
(-> handler
(wrap-pass-through))
-
(-> handler
(res/wrap-resource "public")
(finfo/wrap-file-info)
16 src/ringmon/nrepl.clj
View
@@ -1,4 +1,5 @@
(ns ringmon.nrepl
+ "nREPL trasport, session management, chat facility,"
(:require [clojure.tools.nrepl.server :as server]
[clojure.tools.nrepl.misc :as misc]
[clojure.tools.nrepl.transport :as t]
@@ -56,7 +57,7 @@
;(println "clnt-> patched:" p)
p))
-(defn transport-pair
+(defn- transport-pair
"Returns vector of 2 direct transport instances,
first one for client, and second one for server.
This construct looks very mush like two ends od
@@ -117,9 +118,9 @@
[client-transport server-transport]))
(defn- connect
- "Connects to nREPL server within the same procees using
+ "Connect to nREPL server within the same procees using
the pair of LinkedBlockedQueue instances.
- There is no real server here, just a
+ Actually, there is no real server here, just a
future that handles one to one connection.
Returns client transport instance."
[]
@@ -252,8 +253,9 @@
last-req-time ; last data request time [ms]
last-cmd-time ; last command time [ms]
total-ops ; total ops (reqs+commands)
- top-msg ; top window message to append
- bot-buf] ; bottom window whole buffer to replace
+ top-msg ; top window message(s) to append on the next poll
+ bot-buf-q] ; bottom window buffer updates queue in form of
+ ; {:type t :buf b}. The head of queue to be
SessionStats
(get-stats [this sid]
(let [now (System/currentTimeMillis)
@@ -271,7 +273,7 @@
sessions (ref {}))
(def ^{:doc "Map of pending invite ids to Invite records."}
- records (ref {}))
+ invites (ref {}))
(def ^{:doc "Calculated by check-sessions every 2 seconds."}
active-session-count (atom {}))
@@ -284,7 +286,7 @@
(defn- get-active-sess-count
"Return the number of active sessions. A session is considered active
- if client is issued at least one data request in the last 10 seconds."
+ if client has issued at least one data request in the last 10 seconds."
[]
@active-session-count)
42 src/ringmon/security.clj
View
@@ -0,0 +1,42 @@
+(ns ringmon.security)
+
+(defonce black-set (ref #{}))
+(defonce white-set (ref #{}))
+
+(def ^:const localhost "0:0:0:0:0:0:0:1%0") ; ipv6 equivalent of 127.0.0.1
+
+(def sec-sets
+ {:white white-set
+ :black black-set})
+
+(defn add-to-set
+ "Add element to the disgnated set."
+ [set-key elem]
+ (when-let [set (get sec-sets set-key)]
+ (dosync
+ (alter set conj elem))))
+
+(defn remove-from-set
+ "Remove element from the designated set."
+ [set-key elem]
+ (when-let [set (get sec-sets set-key)]
+ (dosync
+ (alter set disj elem))))
+
+(defn erase-set
+ "Erase designated set."
+ [set-key]
+ (when-let [set (get sec-sets set-key)]
+ (dosync
+ (ref-set set #{}))))
+
+(defn check-ip
+ "Check the supplied 'ip' address against both white and black list,
+ ie.set, which is mathematically more accurate term.
+ Return true if 'ip' is allowed."
+ [ip]
+ (if (empty? @white-set)
+ (when-not (contains? @black-set ip)
+ true)
+ (when (contains? @white-set ip)
+ true)))
49 src/ringmon/server.clj
View
@@ -6,7 +6,7 @@
(:import (java.net Socket ServerSocket URI)
(java.awt Desktop)))
-(defn default [req]
+(defn- default [req]
(resp/redirect "/ringmon/monview.html"))
(def handler
@@ -24,7 +24,7 @@
:ring-handler handler ; simple handler redirect to ringMon page
:http-server nil})) ; will be Jetty if not set
-(defn open-browser-window
+(defn- open-browser-window
"Open the default desktop browser window with target uri"
[target]
(let [sup (Desktop/isDesktopSupported)]
@@ -39,7 +39,7 @@
(catch Exception e
(println "Could not browse to" target "\n" e))))))))
-(defn port-avaliable?
+(defn- port-avaliable?
"Check if TCP port is available."
[port]
(try
@@ -49,7 +49,7 @@
(catch Exception e
(println "Port" port "is not available."))))
-(defn get-port
+(defn- get-port
"Get suitable port for http server, either autoselected or
precofigured."
[]
@@ -65,7 +65,7 @@
port
nil)))
-(defn get-http-server-start-fn
+(defn- get-http-server-start-fn
[]
(require 'ring.adapter.jetty)
(if-not (:http-server @loc-cfg)
@@ -97,32 +97,34 @@
"/ringmon/monview.html")))
true))))
-(defn cfg->map
- [cfg]
- "Convert list of cfg pars in k/v strings form into a Clojure map"
+(defn- cfg->map
+ [cfg]
+ "Convert list of cfg pairs in keyword/value strings
+ form into a Clojure map."
(if-not cfg
{}
(let [p (reduce #(str %1 " " %2) cfg)
s (str "{" p "}")]
(try
(let [cfg (read-string s)]
- (if-not (map? cfg)
- {}
- cfg))
+ (if-not (map? cfg)
+ {}
+ cfg))
(catch Exception e
- (println "Exception:" e)
- (Thread/sleep 100)
- nil))))) ; let the exception print out in peace
+ (println "Exception while parsing command line:\n" e)
+ (Thread/sleep 100) ; let the exception print out in peace
+ nil)))))
(defn -main
"Command line invocation for standalone mode - to be
- invoked with 'lein run'. Relies on
- 'ring/ring-jetty-adapter' being in development dependencies.
- Expects either no parameters, or sequence of keyword/value
+ invoked with 'lein run'. Relies on 'ring/ring-jetty-adapter'
+ being at least in development dependencies.
+ Expects either no parameters, or a sequence of keyword/value
pairs. For example:
- lein run -m ringmon.server :port 10000 :local-repl true
- This will start the dedicated http-server on port 10000 and
- autostart the browser at the REPL interface page."
+ lein run -m ringmon.server :port 9999 :local-repl true
+ This will start a dedicated Jetty http-server on port 9999
+ and create a fresh web browser window with ringMon's
+ nREPL interface page loaded."
[& cfg-pars]
(let [cfg (cfg->map cfg-pars)]
(if-not cfg
@@ -132,9 +134,6 @@
(let [ok (start cfg)]
(print "The standalone ringMon ")
(if ok
- (println (str "up and running using port "
+ (println (str "is up and running using port "
(:port @loc-cfg)"."))
- (println "failed to start."))))))
-
-
-
+ (println "has failed to start."))))))
Please sign in to comment.
Something went wrong with that request. Please try again.