├── README.md ├── chat-demo ├── .gitignore ├── Procfile ├── README.md ├── cljs │ └── bc │ │ ├── core.cljs │ │ └── dom-helpers.cljs ├── project.clj ├── resources │ ├── dev │ │ ├── index-dev.html │ │ └── js │ │ │ └── compile_target_dir │ └── public │ │ ├── css │ │ └── default.css │ │ ├── index.html │ │ └── js │ │ └── compile_target_dir └── src │ ├── chat_demo │ └── core.clj │ └── tasks │ ├── browser_repl.clj │ ├── build_advanced_js.clj │ └── build_dev_js.clj ├── clj-browserchannel-jetty-adapter ├── .gitignore ├── README.md ├── project.clj └── src │ └── net │ └── thegeez │ └── jetty_async_adapter.clj ├── clj-browserchannel-netty-adapter ├── .gitignore ├── README.md ├── project.clj ├── src │ └── net │ │ └── thegeez │ │ └── netty_adapter.clj └── test │ └── clj_browserchannel_netty_adapter │ └── core_test.clj ├── clj-browserchannel-server ├── .gitignore ├── README.md ├── project.clj └── src │ └── net │ └── thegeez │ ├── async_adapter.clj │ └── browserchannel.clj └── test ├── .gitignore ├── README.md ├── project.clj └── src └── test ├── actors.clj └── core.clj /README.md: -------------------------------------------------------------------------------- 1 | # clj-browserchannel 2 | 3 | Cross-browser compatible, real-time, bi-directional 4 | communication between ClojureScript and Clojure using Google Closure 5 | BrowserChannel. 6 | 7 | ## goog.net.BrowserChannel 8 | 9 | From the Google Closure API: "A [BrowserChannel][1] simulates a 10 | bidirectional socket over HTTP. It is the basis of the Gmail Chat IM 11 | connections to the server." 12 | The javascript api of BrowserChannel is open-source and part of the 13 | Google Closure library. The server component is not, as is noted in 14 | the Google Closure book ("Closure: The Definitive Guide by Michael Bolin"). 15 | 16 | [1]: http://closure-library.googlecode.com/svn-history/r144/docs/closure_goog_net_browserchannel.js.html 17 | 18 | ## Demo 19 | 20 | clj-browserchannel-demo is an example chat application using a server 21 | side implementation for BrowserChannel written in Clojure. The server 22 | component is for BrowserChannel version 8. 23 | 24 | This enables client->server and server->client communication in 25 | ClojureScript and Closure web apps, without any javascript 26 | dependencies other than the Google Closure [library][2]. 27 | 28 | [2]: https://developers.google.com/closure/library/ 29 | 30 | The example runs in at least: 31 | 32 | * Chrome 33 | * Firefox 34 | * Internet Explorer 5.5+ (!!) 35 | * Android browser 36 | 37 | ## Jetty Async 38 | 39 | When there are long lasting connections between a client and a 40 | webserver it is desirable to not have a thread per 41 | connection. Therefore this demo runs with with an asynchronous Jetty 42 | adapter. This adapter is compatible with Ring. 43 | 44 | The adapter is based on [ring-jetty-async-adapter][3] by Mark McGranaghan. 45 | 46 | [3]: https://github.com/mmcgrana/ring/tree/jetty-async 47 | 48 | An implementation on top of Netty, through [Aleph][4] is in 49 | development. 50 | 51 | [4]: https://github.com/ztellman/aleph 52 | 53 | ## Related and alternative frameworks 54 | 55 | * Websockets - Websockets solve the same problems as BrowserChannel, 56 | however BrowserChannel works on almost all existing clients. 57 | * socket.io - [socket.io][5] provides a similar api as BrowserChannel on 58 | top of many transport protocols, including websockets. BrowserChannel 59 | only has two transport protocols: XHR and forever frames (for IE) in 60 | streaming and non-streaming mode. 61 | 62 | [5]: http://socket.io 63 | 64 | ## Run 65 | ;; compile cljs 66 | lein run -m tasks.build-dev-js 67 | ;; compile cljs in advanced mode 68 | lein run -m tasks.build-advanced-js 69 | lein run -m chat-demo.core 70 | 71 | Open two windows at [http://localhost:8080/index.html](http://localhost:8080/index.html) (Advanced compiled) 72 | or [http://localhost:8080/index-dev.html](http://localhost:8080/index-dev.html) and start chatting! 73 | 74 | ## Run on Heroku 75 | Use the Heroku Clojure [buildpack][7]. 76 | 77 | heroku config:add BUILDPACK_URL=https://github.com/heroku/heroku-buildpack-clojure.git 78 | 79 | This project additionally 80 | requires two build tasks to compile the ClojureScript during deployment. 81 | 82 | Enable [user_env_compile][6]: 83 | 84 | heroku labs:enable user_env_compile -a 85 | 86 | Add this config var: 87 | 88 | heroku config:add LEIN_BUILD_TASK="run -m tasks.build-dev-js, run -m tasks.build-advanced-js" 89 | 90 | [6]: https://devcenter.heroku.com/articles/labs-user-env-compile 91 | [7]: https://github.com/heroku/heroku-buildpack-clojure.git 92 | 93 | ### Note on disconnections on Heroku 94 | I have found that Heroku does not immediately report when a connection to a client 95 | is broken. If the client is able to reconnect this is not a problem, 96 | as this is supported by the BrowserChannel API. However when you 97 | unplug the internet cable the client cannot reconnect and the server 98 | must timeout the session. Ussually this happens when trying to send the next 99 | heartbeat to the client. On Heruko this does not report an error, even 100 | though there is no connection to the client. So instead of the 101 | connection timeing out on a heartbeat (after seconds/a minute) the 102 | connection will only timeout after the connection is timed out by the 103 | server (4 minutes by default). The Netty implementation has the same 104 | problem on Heroku. Deployments on Amazon Web Services do not have this 105 | problem. 106 | 107 | ## Configuration: 108 | See default-options in src/net/thegeez/browserchannel.clj 109 | And the :response-timeout option in src/net/thegeez/jetty_async_adapter.clj 110 | 111 | ### Debug / Play around 112 | BrowserChannel has a helpful debug window. Uncomment the debug-window 113 | and .setChannelDebug lines in cljs/bc/core.cljs to enable the logging window. 114 | 115 | ## Todo 116 | - Release backend as library 117 | - Handling acknowledgements by client and callbacks on queued arrays 118 | - Host prefixes 119 | - Heroku disconnection 120 | - Replace session listeners, possibly with lamina 121 | - Explore other event based Java webservers, such as Netty and Webbit 122 | 123 | ## Other BrowserChannel implementations 124 | Many thanks to these authors, their work is the only open-source 125 | documentation on the BrowserChannel protocol. 126 | 127 | * [libevent-browserchannel-server][libevent] 128 | in C++ by Andy Hochhaus - Has the most extensive [documentation][libevent-doc] on the BrowserChannel protocol 129 | * [browserchannel][ruby] in Ruby by David Turnbull 130 | * [node-browserchannel][node] 131 | in Node.js/Javascript by Joseph Gentle 132 | 133 | [libevent]: http://code.google.com/p/libevent-browserchannel-server 134 | [libevent-doc]: http://code.google.com/p/libevent-browserchannel-server/wiki/BrowserChannelProtocol 135 | [ruby]: https://github.com/dturnbull/browserchannel 136 | [node]: https://github.com/josephg/node-browserchannel 137 | 138 | ## About 139 | 140 | Written by: 141 | Gijs Stuurman / [@thegeez][twt] / [Blog][blog] / [GitHub][github] 142 | 143 | [twt]: http://twitter.com/thegeez 144 | [blog]: http://thegeez.github.com 145 | [github]: https://github.com/thegeez 146 | 147 | ### License 148 | 149 | Copyright (c) 2012 Gijs Stuurman and released under an MIT license. 150 | -------------------------------------------------------------------------------- /chat-demo/.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | *.jar 7 | *.class 8 | .lein-deps-sum 9 | .lein-failures 10 | .lein-plugins 11 | .repl 12 | resources/dev/js 13 | resources/public/js 14 | -------------------------------------------------------------------------------- /chat-demo/Procfile: -------------------------------------------------------------------------------- 1 | web: lein trampoline run -m chat-demo.core 2 | -------------------------------------------------------------------------------- /chat-demo/README.md: -------------------------------------------------------------------------------- 1 | # chat-demo for clj-browserchannel-demo 2 | 3 | Cross-browser compatible, real-time, bi-directional 4 | communication between ClojureScript and Clojure using Google Closure 5 | BrowserChannel. 6 | 7 | See also: [clj-browserchannel][1] 8 | [1]:https://github.com/thegeez/clj-browserchannel 9 | 10 | ## Demo 11 | 12 | clj-browserchannel-demo is an example chat application using a server 13 | side implementation for BrowserChannel written in Clojure. The server 14 | component is for BrowserChannel version 8. 15 | 16 | This enables client->server and server->client communication in 17 | ClojureScript and Closure web apps, without any javascript 18 | dependencies other than the Google Closure [library][2]. 19 | 20 | [2]: https://developers.google.com/closure/library/ 21 | 22 | The example runs in at least: 23 | 24 | * Chrome 25 | * Firefox 26 | * Internet Explorer 5.5+ (!!) 27 | * Android browser 28 | 29 | ## About 30 | 31 | Written by: 32 | Gijs Stuurman / [@thegeez][twt] / [Blog][blog] / [GitHub][github] 33 | 34 | [twt]: http://twitter.com/thegeez 35 | [blog]: http://thegeez.github.com 36 | [github]: https://github.com/thegeez 37 | 38 | ### License 39 | 40 | Copyright (c) 2012 Gijs Stuurman and released under an MIT license. 41 | -------------------------------------------------------------------------------- /chat-demo/cljs/bc/core.cljs: -------------------------------------------------------------------------------- 1 | (ns bc.core 2 | (:require 3 | [bc.dom-helpers :as dom] 4 | [goog.net.BrowserChannel :as goog-browserchannel] 5 | [goog.events :as events] 6 | [goog.events.KeyCodes :as key-codes] 7 | [goog.events.KeyHandler :as key-handler])) 8 | 9 | (defn handler [] 10 | (let [h (goog.net.BrowserChannel.Handler.)] 11 | (set! (.-channelOpened h) 12 | (fn [channel] 13 | (enable-chat))) 14 | (set! (.-channelHandleArray h) 15 | (fn [x data] 16 | (let [msg (aget data "msg")] 17 | (dom/append (dom/get-element "room") (dom/element :div (str "MSG::" msg)))))) 18 | h)) 19 | 20 | (defn say [text] 21 | (.sendMap channel (doto (js-obj) 22 | (aset "msg" text)) )) 23 | 24 | (defn enable-chat [] 25 | (let [msg-input (dom/get-element "msg-input") 26 | send-button (dom/get-element "send-button") 27 | handler (fn [e] 28 | (say (dom/value msg-input)) 29 | (dom/set-value msg-input ""))] 30 | (dom/set-disabled msg-input false) 31 | (dom/set-disabled send-button false) 32 | (events/listen (goog.events.KeyHandler. msg-input) 33 | "key" 34 | (fn [e] 35 | (when (= (.-keyCode e) key-codes/ENTER) 36 | (handler e)))) 37 | (events/listen send-button 38 | "click" 39 | handler))) 40 | 41 | (def channel (goog.net.BrowserChannel.)) 42 | 43 | (defn ^:export run [] 44 | (events/listen js/window "unload" #(do 45 | (.disconnect channel ()) 46 | (events/removeAll))) 47 | (doto (.. channel getChannelDebug getLogger) 48 | (.setLevel goog.debug.Logger.Level.OFF)) 49 | (doto channel 50 | (.setHandler (handler)) 51 | (.connect "/channel/test" "/channel/bind") 52 | )) 53 | -------------------------------------------------------------------------------- /chat-demo/cljs/bc/dom-helpers.cljs: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | (ns bc.dom-helpers 10 | (:require [clojure.string :as string] 11 | [goog.style :as style] 12 | [goog.dom :as dom] 13 | [goog.dom.classes :as classes] 14 | [goog.dom.forms :as forms] 15 | [goog.fx :as fx] 16 | [goog.fx.dom :as fx-dom] 17 | [goog.Timer :as timer] 18 | )) 19 | 20 | (defn get-element 21 | "Return the element with the passed id." 22 | [id] 23 | (dom/getElement (name id))) 24 | 25 | (defn show-element [e b] 26 | (style/showElement e b)) 27 | 28 | (defn add-remove-class [e add-classes remove-classes] 29 | (classes/addRemove e remove-classes add-classes)) 30 | 31 | (defn get-radio-value [form-name name] 32 | (forms/getValueByName (get-element form-name) name)) 33 | 34 | (defn value [element] 35 | (forms/getValue element)) 36 | 37 | (defn set-value [element] 38 | (forms/setValue element)) 39 | 40 | (defn set-disabled [element disabled] 41 | (forms/setDisabled element disabled)) 42 | 43 | (defn append 44 | "Append all children to parent." 45 | [parent & children] 46 | (do (doseq [child children] 47 | (dom/appendChild parent child)) 48 | parent)) 49 | 50 | (defn set-text 51 | "Set the text content for the passed element returning the 52 | element. If a keyword is passed in the place of e, the element with 53 | that id will be used and returned." 54 | [e s] 55 | (let [e (if (or (keyword? e) (string? e)) (get-element e) e)] 56 | (doto e 57 | (dom/setTextContent s)))) 58 | 59 | (defn normalize-args [tag args] 60 | (let [parts (string/split tag #"(\.|#)") 61 | [tag attrs] [(first parts) 62 | (apply hash-map (map #(cond (= % ".") :class 63 | (= % "#") :id 64 | :else %) 65 | (rest parts)))]] 66 | (if (map? (first args)) 67 | [tag (merge attrs (first args)) (rest args)] 68 | [tag attrs args]))) 69 | 70 | ;; TODO: replace call to .strobj with whatever we come up with for 71 | ;; creating js objects from Clojure maps. 72 | 73 | (defn element 74 | "Create a dom element using a keyword for the element name and a map 75 | for the attributes. Append all children to parent. If the first 76 | child is a string then the string will be set as the text content of 77 | the parent and all remaining children will be appended." 78 | [tag & args] 79 | (let [[tag attrs children] (normalize-args tag args) 80 | ;; keyword/string mangling screws up (name tag) 81 | parent (dom/createDom (subs tag 1) 82 | (. (reduce (fn [m [k v]] 83 | (assoc m k v)) 84 | {} 85 | (map #(vector (name %1) %2) 86 | (keys attrs) 87 | (vals attrs))) -strobj)) 88 | [parent children] (if (string? (first children)) 89 | [(set-text (element tag attrs) (first children)) 90 | (rest children)] 91 | [parent children])] 92 | (apply append parent children))) 93 | 94 | (defn remove-children 95 | "Remove all children from the element with the passed id." 96 | [parent-el] 97 | (dom/removeChildren parent-el)) 98 | 99 | (defn html 100 | "Create a dom element from an html string." 101 | [s] 102 | (dom/htmlToDocumentFragment s)) 103 | 104 | (defn- element-arg? [x] 105 | (or (keyword? x) 106 | (map? x) 107 | (string? x))) 108 | 109 | (defn build 110 | "Build up a dom element from nested vectors." 111 | [x] 112 | (if (vector? x) 113 | (let [[parent children] (if (keyword? (first x)) 114 | [(apply element (take-while element-arg? x)) 115 | (drop-while element-arg? x)] 116 | [(first x) (rest x)]) 117 | children (map build children)] 118 | (apply append parent children)) 119 | x)) 120 | 121 | (defn insert-at 122 | "Insert a child element at a specific location." 123 | [parent child index] 124 | (dom/insertChildAt parent child index)) 125 | 126 | (defn set-timeout [func ttime] 127 | (timer/callOnce func ttime)) 128 | 129 | (defn set-position [e x y] 130 | (style/setPosition e x y)) 131 | 132 | (defn get-position [e] 133 | (style/getPosition e)) 134 | 135 | (defn toggle-class [el classname] 136 | (classes/toggle el classname)) 137 | 138 | (defn add-class [el classname] 139 | (classes/add el classname)) 140 | (defn remove-class [el classname] 141 | (classes/remove el classname)) 142 | -------------------------------------------------------------------------------- /chat-demo/project.clj: -------------------------------------------------------------------------------- 1 | (defproject chat-demo "0.0.1" 2 | :description "Example for using BrowserChannel and a client side with ClojureScript" 3 | :dependencies [[org.clojure/clojure "1.3.0"] 4 | [ring/ring-core "1.1.0-SNAPSHOT" :exclusions [javax.servlet/servlet-api]] 5 | [org.clojure/clojurescript "0.0-1011" :exclusions [org.clojure/google-closure-library]] 6 | [net.thegeez/google-closure-library "0.0-1698"] 7 | [net.thegeez/clj-browserchannel-server "0.0.4"] 8 | [net.thegeez/clj-browserchannel-jetty-adapter "0.0.1"] 9 | #_[net.thegeez/clj-browserchannel-netty-adapter "0.0.1"] 10 | ] 11 | ) 12 | -------------------------------------------------------------------------------- /chat-demo/resources/dev/index-dev.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | BrowserChannel 7 | 8 | 11 | 12 | 13 | 14 |
15 |
16 |
17 | 18 | 19 |
20 |
clj-browserchannel-demo
21 |
22 | Written by: Gijs Stuurman 23 | / @thegeez 24 | / Blog / GitHub
25 | 28 | 29 | 32 | 36 | 37 | 38 | -------------------------------------------------------------------------------- /chat-demo/resources/dev/js/compile_target_dir: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kirasystems/clj-browserchannel/68d2ebc6336fbf7d71e6e54d61ca85bb4b2546af/chat-demo/resources/dev/js/compile_target_dir -------------------------------------------------------------------------------- /chat-demo/resources/public/css/default.css: -------------------------------------------------------------------------------- 1 | body { 2 | font-family: Arial, Helvetica, sans-serif; 3 | font-size: 10pt; 4 | background-color: #8fb3fc; 5 | } 6 | 7 | #room { 8 | border: 3px solid #5780d7; 9 | background-color: #f4eeee; 10 | min-height: 10em; 11 | } 12 | #type-bar { 13 | padding: 3px; 14 | background-color: #62b031; 15 | } 16 | .about { 17 | padding: 3px; 18 | background-color: #90db46; 19 | } 20 | -------------------------------------------------------------------------------- /chat-demo/resources/public/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | BrowserChannel 7 | 8 | 11 | 12 | 13 | 14 |
15 |
16 |
17 | 18 | 19 |
20 |
clj-browserchannel-demo
21 |
22 | Written by: Gijs Stuurman 23 | / @thegeez 24 | / Blog / GitHub
25 | 26 | 29 | 30 | 31 | -------------------------------------------------------------------------------- /chat-demo/resources/public/js/compile_target_dir: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kirasystems/clj-browserchannel/68d2ebc6336fbf7d71e6e54d61ca85bb4b2546af/chat-demo/resources/public/js/compile_target_dir -------------------------------------------------------------------------------- /chat-demo/src/chat_demo/core.clj: -------------------------------------------------------------------------------- 1 | (ns chat-demo.core 2 | (:require [net.thegeez.browserchannel :as browserchannel] 3 | [net.thegeez.jetty-async-adapter :as jetty] 4 | #_[net.thegeez.netty-adapter :as netty] 5 | [ring.middleware.resource :as resource] 6 | [ring.middleware.file-info :as file])) 7 | 8 | (defn handler [req] 9 | {:status 200 10 | :headers {"Content-Type" "text/plain"} 11 | :body "Hello World"}) 12 | 13 | (def clients (atom #{})) 14 | 15 | (def dev-app 16 | (-> handler 17 | (resource/wrap-resource "dev") 18 | (resource/wrap-resource "public") 19 | file/wrap-file-info 20 | (browserchannel/wrap-browserchannel {:base "/channel" 21 | :on-session 22 | (fn [session-id req] 23 | (println "session " session-id "connected") 24 | 25 | (browserchannel/add-listener 26 | session-id 27 | :close 28 | (fn [reason] 29 | (println "session " session-id " disconnected: " reason) 30 | (swap! clients disj session-id) 31 | (doseq [client-id @clients] 32 | (browserchannel/send-map client-id {"msg" (str "client " session-id " disconnected " reason)})))) 33 | (browserchannel/add-listener 34 | session-id 35 | :map 36 | (fn [map] 37 | (println "session " session-id " sent " map) 38 | (doseq [client-id @clients] 39 | (browserchannel/send-map client-id map)))) 40 | (swap! clients conj session-id) 41 | (doseq [client-id @clients] 42 | (browserchannel/send-map client-id {"msg" (str "client " session-id " connected")})))}))) 43 | 44 | (defn -main [& args] 45 | (println "Using Jetty adapter") 46 | (jetty/run-jetty-async #'dev-app {:port (Integer. 47 | (or 48 | (System/getenv "PORT") 49 | 8080)) :join? false})) 50 | 51 | #_(defn -main [& args] 52 | (println "Using Netty adapter") 53 | (netty/run-netty #'dev-app {:port (Integer. 54 | (or 55 | (System/getenv "PORT") 56 | 8080)) :join? false})) 57 | 58 | 59 | (comment 60 | (def jetty-async-server (-main)) 61 | (.stop jetty-async-server) 62 | (do 63 | (.stop jetty-async-server) 64 | (def jetty-async-server (-main)) 65 | ) 66 | ) 67 | 68 | (comment 69 | (def netty-async-server (-main)) 70 | (netty-async-server) 71 | (do 72 | (netty-async-server) 73 | (def netty-async-server (-main)) 74 | ) 75 | ) 76 | -------------------------------------------------------------------------------- /chat-demo/src/tasks/browser_repl.clj: -------------------------------------------------------------------------------- 1 | (ns tasks.browser-repl 2 | (require [cljs.repl :as repl]) 3 | (require [cljs.repl.browser :as browser])) 4 | 5 | (defn -main [] 6 | (repl/repl (browser/repl-env))) 7 | -------------------------------------------------------------------------------- /chat-demo/src/tasks/build_advanced_js.clj: -------------------------------------------------------------------------------- 1 | (ns tasks.build-advanced-js 2 | (:require [cljs.closure :as cljs])) 3 | 4 | (defn -main [& args] 5 | (cljs/build "cljs" {:optimizations :advanced 6 | :output-to "resources/public/js/bc.js"})) 7 | -------------------------------------------------------------------------------- /chat-demo/src/tasks/build_dev_js.clj: -------------------------------------------------------------------------------- 1 | (ns tasks.build-dev-js 2 | (:require [cljs.closure :as cljs]) 3 | (:import [java.io File])) 4 | 5 | (def config {:sources-path "cljs" 6 | ;; whitespace makes it a single file 7 | :optimizations :whitespace 8 | :output-to "resources/dev/js/bc-dev.js"}) 9 | 10 | (defn print-title [msg] 11 | (println (str "\033]0;" msg "\007")) 12 | (println msg)) 13 | 14 | (defn build [] 15 | (print-title "CLJSB - building") 16 | (cljs/build (:sources-path config) (dissoc config :sources-path)) 17 | (print-title "cljsb - done")) 18 | 19 | (defn -main [& [cmd]] 20 | (print-title "cljsb") 21 | (if-not (= cmd "auto") 22 | (build) 23 | (loop [old-entries {}] 24 | (let [entries (into {} (for [file-dir (tree-seq #(.isDirectory %) 25 | #(.listFiles %) 26 | (File. (:sources-path config))) 27 | :let [name (.getName file-dir)] 28 | :when (and 29 | (not (.contains name "#")) 30 | (.endsWith name ".cljs"))] 31 | [(.getPath file-dir) (.lastModified file-dir)]))] 32 | (when (some (fn [[entry-path entry-stamp]] 33 | (let [old-entry-stamp (old-entries entry-path)] 34 | (or (nil? old-entry-stamp) 35 | (> entry-stamp old-entry-stamp)))) entries) 36 | (build)) 37 | (Thread/sleep 700) 38 | (recur entries))))) 39 | -------------------------------------------------------------------------------- /clj-browserchannel-jetty-adapter/.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | *.jar 7 | *.class 8 | .lein-deps-sum 9 | .lein-failures 10 | .lein-plugins -------------------------------------------------------------------------------- /clj-browserchannel-jetty-adapter/README.md: -------------------------------------------------------------------------------- 1 | # clj-browserchannel-jetty-adapter 2 | 3 | Jetty async adapter for BrowserChannel 4 | 5 | See also: [clj-browserchannel][1] 6 | [1]:https://github.com/thegeez/clj-browserchannel 7 | 8 | ## About 9 | 10 | Written by: 11 | Gijs Stuurman / [@thegeez][twt] / [Blog][blog] / [GitHub][github] 12 | 13 | [twt]: http://twitter.com/thegeez 14 | [blog]: http://thegeez.github.com 15 | [github]: https://github.com/thegeez 16 | 17 | ### License 18 | 19 | Copyright (c) 2012 Gijs Stuurman and released under an MIT license. 20 | -------------------------------------------------------------------------------- /clj-browserchannel-jetty-adapter/project.clj: -------------------------------------------------------------------------------- 1 | (defproject net.thegeez/clj-browserchannel-jetty-adapter "0.0.8" 2 | :description "Jetty async adapter for BrowserChannel" 3 | :url "" 4 | :dependencies [[ring/ring-core "1.3.1"] 5 | [ring/ring-servlet "1.3.1"] 6 | [org.eclipse.jetty/jetty-server "8.1.16.v20140903"];; includes ssl 7 | [net.thegeez/clj-browserchannel-server "0.2.1"]] 8 | :profiles {:provided 9 | {:dependencies 10 | [[org.clojure/clojure "1.6.0"]]}}) 11 | -------------------------------------------------------------------------------- /clj-browserchannel-jetty-adapter/src/net/thegeez/jetty_async_adapter.clj: -------------------------------------------------------------------------------- 1 | (ns net.thegeez.jetty-async-adapter 2 | "BrowserChannel adapter for the Jetty webserver, with async HTTP." 3 | (:import [org.eclipse.jetty.server.handler AbstractHandler] 4 | [org.eclipse.jetty.server Server Request Response] 5 | [org.eclipse.jetty.server.nio SelectChannelConnector] 6 | [org.eclipse.jetty.server.ssl SslSelectChannelConnector] 7 | [org.eclipse.jetty.util.ssl SslContextFactory] 8 | [org.eclipse.jetty.continuation Continuation ContinuationSupport ContinuationListener] 9 | [org.eclipse.jetty.io EofException] 10 | [javax.servlet.http HttpServletRequest] 11 | [java.security KeyStore]) 12 | (:require [ring.util.servlet :as servlet] 13 | [net.thegeez.async-adapter :as async-adapter])) 14 | 15 | ;; Based on ring-jetty-async-adapter by Mark McGranaghan 16 | ;; (https://github.com/mmcgrana/ring/tree/jetty-async) 17 | ;; This has failed write support 18 | 19 | (deftype JettyAsyncResponse [^Continuation continuation] 20 | async-adapter/IAsyncAdapter 21 | (head [this status headers] 22 | (doto (.getServletResponse continuation) 23 | (servlet/update-servlet-response {:status status, :headers (assoc headers "Transfer-Encoding" "chunked")}) 24 | (.flushBuffer))) 25 | (write-chunk [this data] 26 | (doto (.getWriter (.getServletResponse continuation)) 27 | (.write ^String data) 28 | (.flush)) 29 | (when (.checkError (.getWriter (.getServletResponse continuation))) 30 | (throw async-adapter/ConnectionClosedException))) 31 | (close [this] 32 | (doto (.getWriter (.getServletResponse continuation)) 33 | (.write "") 34 | (.flush)) 35 | (.complete continuation))) 36 | 37 | (defn- add-ssl-connector! 38 | "Add an SslSelectChannelConnector to a Jetty Server instance." 39 | [^Server server options] 40 | (let [ssl-context-factory (SslContextFactory.)] 41 | (doto ssl-context-factory 42 | (.setKeyStorePath (options :keystore)) 43 | (.setKeyStorePassword (options :key-password))) 44 | (when (options :truststore) 45 | (.setTrustStore ssl-context-factory ^KeyStore (options :truststore))) 46 | (when (options :trust-password) 47 | (.setTrustStorePassword ssl-context-factory (options :trust-password))) 48 | (when (options :include-cipher-suites) 49 | (.setIncludeCipherSuites ssl-context-factory (into-array (options :include-cipher-suites)))) 50 | (when (options :include-protocols) 51 | (.setIncludeProtocols ssl-context-factory (into-array (options :include-protocols)))) 52 | (let [conn (SslSelectChannelConnector. ssl-context-factory)] 53 | (.addConnector server (doto conn (.setPort (options :ssl-port 8443))))))) 54 | 55 | (defn- proxy-handler 56 | "Returns an Jetty Handler implementation for the given Ring handler." 57 | [handler options] 58 | (proxy [AbstractHandler] [] 59 | (handle [target ^Request base-request ^HttpServletRequest request response] 60 | (let [request-map (servlet/build-request-map request) 61 | response-map (handler request-map)] 62 | (condp = (:async response-map) 63 | nil 64 | (do 65 | (servlet/update-servlet-response response response-map) 66 | (.setHandled base-request true)) 67 | :http 68 | (let [reactor (:reactor response-map) 69 | continuation ^Continuation (.startAsync request) ;; continuation lives until written to! 70 | emit (JettyAsyncResponse. continuation)] 71 | (.addContinuationListener continuation 72 | (proxy [ContinuationListener] [] 73 | (onComplete [c] nil) 74 | (onTimeout [^Continuation c] (.complete c)))) 75 | 76 | ;; 4 minutes is google default 77 | (.setTimeout continuation (get options :response-timeout (* 4 60 1000))) 78 | (reactor emit))))))) 79 | 80 | (defn- create-server 81 | "Construct a Jetty Server instance." 82 | [options] 83 | (let [connector (doto (SelectChannelConnector.) 84 | (.setPort (options :port 80)) 85 | (.setHost (options :host))) 86 | server (doto (Server.) 87 | (.addConnector connector) 88 | (.setSendDateHeader true))] 89 | (when (or (options :ssl?) (options :ssl-port)) 90 | (add-ssl-connector! server options)) 91 | server)) 92 | 93 | (defn ^Server run-jetty-async 94 | "Serve the given handler according to the options. 95 | Options: 96 | :configurator - A function called with the Server instance. 97 | :port 98 | :host 99 | :join? - Block the caller: defaults to true. 100 | :response-timeout - Timeout after which the server will close the connection" 101 | [handler options] 102 | (let [^Server s (create-server (dissoc options :configurator))] 103 | (when-let [configurator (:configurator options)] 104 | (configurator s)) 105 | (doto s 106 | (.setHandler (proxy-handler handler options)) 107 | (.start)) 108 | (when (:join? options true) 109 | (.join s)) 110 | s)) 111 | -------------------------------------------------------------------------------- /clj-browserchannel-netty-adapter/.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | *.jar 7 | *.class 8 | .lein-deps-sum 9 | .lein-failures 10 | .lein-plugins -------------------------------------------------------------------------------- /clj-browserchannel-netty-adapter/README.md: -------------------------------------------------------------------------------- 1 | # clj-browserchannel-netty-adapter 2 | 3 | Netty adapter for use with BrowserChannel on top of Aleph. 4 | 5 | See also: [clj-browserchannel][1] 6 | [1]:https://github.com/thegeez/clj-browserchannel 7 | 8 | ## About 9 | 10 | Written by: 11 | Gijs Stuurman / [@thegeez][twt] / [Blog][blog] / [GitHub][github] 12 | 13 | [twt]: http://twitter.com/thegeez 14 | [blog]: http://thegeez.github.com 15 | [github]: https://github.com/thegeez 16 | 17 | ### License 18 | 19 | Copyright (c) 2012 Gijs Stuurman and released under an MIT license. 20 | -------------------------------------------------------------------------------- /clj-browserchannel-netty-adapter/project.clj: -------------------------------------------------------------------------------- 1 | (defproject net.thegeez/clj-browserchannel-netty-adapter "0.0.1" 2 | :description "Netty adapter for BrowserChannel through Aleph" 3 | :dependencies [[org.clojure/clojure "1.3.0"] 4 | [aleph "0.2.1-SNAPSHOT"] 5 | [net.thegeez/clj-browserchannel-server "0.0.1"] 6 | ]) 7 | -------------------------------------------------------------------------------- /clj-browserchannel-netty-adapter/src/net/thegeez/netty_adapter.clj: -------------------------------------------------------------------------------- 1 | (ns net.thegeez.netty-adapter 2 | "BrowserChannel adapter for the Netty webserver" 3 | (:require [aleph.http :as aleph] 4 | [lamina.core :as l] 5 | [net.thegeez.async-adapter :as async-adapter])) 6 | 7 | 8 | (deftype NettyResponse [response-channel 9 | body-channel] 10 | async-adapter/IAsyncAdapter 11 | (head [this status headers] 12 | (l/enqueue response-channel 13 | {:status status 14 | :headers headers 15 | :body body-channel})) 16 | (write-chunk [this data] 17 | (if (l/closed? body-channel) 18 | (throw async-adapter/ConnectionClosedException) 19 | (l/enqueue body-channel data))) 20 | (close [this] 21 | (l/close body-channel))) 22 | 23 | 24 | (defn wrap-aleph-async-adapter [handler] 25 | (fn [req] 26 | (let [response-map (handler req)] 27 | (condp = (:async response-map) 28 | nil 29 | ;; regular ring response 30 | response-map 31 | :http 32 | (let [reactor (:reactor response-map) 33 | response-channel (:channel req) 34 | emit (NettyResponse. response-channel (l/channel))] 35 | (reactor emit) 36 | ;; this tells aleph to return nil as a ring handler 37 | {:status 200 38 | ::ignore true}))))) 39 | 40 | 41 | (defn run-netty [handler options] 42 | (aleph/start-http-server (aleph/wrap-ring-handler (wrap-aleph-async-adapter handler)) options)) 43 | -------------------------------------------------------------------------------- /clj-browserchannel-netty-adapter/test/clj_browserchannel_netty_adapter/core_test.clj: -------------------------------------------------------------------------------- 1 | (ns clj-browserchannel-netty-adapter.core-test 2 | (:use clojure.test 3 | clj-browserchannel-netty-adapter.core)) 4 | 5 | (deftest a-test 6 | (testing "FIXME, I fail." 7 | (is (= 0 1)))) -------------------------------------------------------------------------------- /clj-browserchannel-server/.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | *.jar 7 | *.class 8 | .lein-deps-sum 9 | .lein-failures 10 | .lein-plugins -------------------------------------------------------------------------------- /clj-browserchannel-server/README.md: -------------------------------------------------------------------------------- 1 | # clj-browserchannel-server 2 | 3 | Cross-browser compatible, real-time, bi-directional 4 | communication between ClojureScript and Clojure using Google Closure 5 | BrowserChannel. 6 | 7 | See also: [clj-browserchannel][0] 8 | [0]:https://github.com/thegeez/clj-browserchannel 9 | 10 | ## goog.net.BrowserChannel 11 | 12 | From the Google Closure API: "A [BrowserChannel][1] simulates a 13 | bidirectional socket over HTTP. It is the basis of the Gmail Chat IM 14 | connections to the server." 15 | The javascript api of BrowserChannel is open-source and part of the 16 | Google Closure library. The server component is not, as is noted in 17 | the Google Closure book ("Closure: The Definitive Guide by Michael Bolin"). 18 | 19 | [1]: http://closure-library.googlecode.com/svn-history/r144/docs/closure_goog_net_browserchannel.js.html 20 | 21 | ## Demo 22 | 23 | This project is a server side implementation for BrowserChannel 24 | written in Clojure. The server component is for BrowserChannel version 8. 25 | 26 | This enables client->server and server->client communication in 27 | ClojureScript and Closure web apps, without any javascript 28 | dependencies other than the Google Closure [library][2]. 29 | 30 | [2]: https://developers.google.com/closure/library/ 31 | 32 | The browserchannel client side runs in at least: 33 | 34 | * Chrome 35 | * Firefox 36 | * Internet Explorer 5.5+ (!!) 37 | * Android browser 38 | 39 | ## Jetty Async 40 | 41 | When there are long lasting connections between a client and a 42 | webserver it is desirable to not have a thread per 43 | connection. Therefore this demo runs with with an asynchronous Jetty 44 | adapter. This adapter is compatible with Ring. 45 | 46 | The adapter is based on [ring-jetty-async-adapter][3] by Mark McGranaghan. 47 | 48 | [3]: https://github.com/mmcgrana/ring/tree/jetty-async 49 | 50 | ## Netty 51 | 52 | The server component can also run on top of Netty, through [Aleph][4]. 53 | 54 | [4]: https://github.com/ztellman/aleph 55 | 56 | ## Related and alternative frameworks 57 | 58 | * Websockets - Websockets solve the same problems as BrowserChannel, 59 | however BrowserChannel works on almost all existing clients. 60 | * socket.io - [socket.io][5] provides a similar api as BrowserChannel on 61 | top of many transport protocols, including websockets. BrowserChannel 62 | only has two transport protocols: XHR and forever frames (for IE) in 63 | streaming and non-streaming mode. 64 | 65 | [5]: http://socket.io 66 | 67 | ## Run 68 | ;; compile cljs 69 | lein run -m tasks.build-dev-js 70 | ;; compile cljs in advanced mode 71 | lein run -m tasks.build-advanced-js 72 | lein run -m chat-demo.core 73 | 74 | Open two windows at [http://localhost:8080/index.html](http://localhost:8080/index.html) (Advanced compiled) 75 | or [http://localhost:8080/index-dev.html](http://localhost:8080/index-dev.html) and start chatting! 76 | 77 | ## Run on Heroku 78 | Use the Heroku Clojure [buildpack][7]. 79 | 80 | heroku config:add BUILDPACK_URL=https://github.com/heroku/heroku-buildpack-clojure.git 81 | 82 | This project additionally 83 | requires two build tasks to compile the ClojureScript during deployment. 84 | 85 | Enable [user_env_compile][6]: 86 | 87 | heroku labs:enable user_env_compile -a 88 | 89 | Add this config var: 90 | 91 | heroku config:add LEIN_BUILD_TASK="run -m tasks.build-dev-js, run -m tasks.build-advanced-js" 92 | 93 | [6]: https://devcenter.heroku.com/articles/labs-user-env-compile 94 | [7]: https://github.com/heroku/heroku-buildpack-clojure.git 95 | 96 | ### Note on disconnections on Heroku 97 | I have found that Heroku does not immediately report when a connection to a client 98 | is broken. If the client is able to reconnect this is not a problem, 99 | as this is supported by the BrowserChannel API. However when you 100 | unplug the internet cable the client cannot reconnect and the server 101 | must timeout the session. Ussually this happens when trying to send the next 102 | heartbeat to the client. On Heruko this does not report an error, even 103 | though there is no connection to the client. So instead of the 104 | connection timeing out on a heartbeat (after seconds/a minute) the 105 | connection will only timeout after the connection is timed out by the 106 | server (4 minutes by default). The Netty implementation has the same 107 | problem on Heroku. Deployments on Amazon Web Services do not have this 108 | problem. 109 | 110 | ## Configuration: 111 | See default-options in src/net/thegeez/browserchannel.clj 112 | And the :response-timeout option in src/net/thegeez/jetty_async_adapter.clj 113 | 114 | ## Todo 115 | - Handling acknowledgements by client and callbacks on queued arrays 116 | - Host prefixes 117 | - Heroku disconnection 118 | - Replace session listeners, possibly with lamina 119 | - Explore other event based Java webservers, such as Netty and Webbit 120 | 121 | ## Other BrowserChannel implementations 122 | Many thanks to these authors, their work is the only open-source 123 | documentation on the BrowserChannel protocol. 124 | 125 | * [libevent-browserchannel-server][libevent] 126 | in C++ by Andy Hochhaus - Has the most extensive [documentation][libevent-doc] on the BrowserChannel protocol 127 | * [browserchannel][ruby] in Ruby by David Turnbull 128 | * [node-browserchannel][node] 129 | in Node.js/Javascript by Joseph Gentle 130 | 131 | [libevent]: http://code.google.com/p/libevent-browserchannel-server 132 | [libevent-doc]: http://code.google.com/p/libevent-browserchannel-server/wiki/BrowserChannelProtocol 133 | [ruby]: https://github.com/dturnbull/browserchannel 134 | [node]: https://github.com/josephg/node-browserchannel 135 | 136 | ## About 137 | 138 | Written by: 139 | Gijs Stuurman / [@thegeez][twt] / [Blog][blog] / [GitHub][github] 140 | 141 | [twt]: http://twitter.com/thegeez 142 | [blog]: http://thegeez.github.com 143 | [github]: https://github.com/thegeez 144 | 145 | ### License 146 | 147 | Copyright (c) 2012 Gijs Stuurman and released under an MIT license. 148 | -------------------------------------------------------------------------------- /clj-browserchannel-server/project.clj: -------------------------------------------------------------------------------- 1 | (defproject net.thegeez/clj-browserchannel-server "0.2.1" 2 | :description "BrowserChannel server implementation in Clojure" 3 | :dependencies [[ring/ring-core "1.3.1"] 4 | [org.clojure/data.json "0.2.5"]] 5 | :profiles {:provided 6 | {:dependencies 7 | [[org.clojure/clojure "1.6.0"]]}}) 8 | -------------------------------------------------------------------------------- /clj-browserchannel-server/src/net/thegeez/async_adapter.clj: -------------------------------------------------------------------------------- 1 | (ns net.thegeez.async-adapter) 2 | 3 | (defprotocol IAsyncAdapter 4 | (head [this status headers]) 5 | ;; chunk throws exception when connection is closed 6 | (write-chunk [this data]) 7 | (close [this])) 8 | 9 | (def ConnectionClosedException (Exception. "CANNOT WRITE TO STREAMING CONNECTION")) 10 | -------------------------------------------------------------------------------- /clj-browserchannel-server/src/net/thegeez/browserchannel.clj: -------------------------------------------------------------------------------- 1 | (ns net.thegeez.browserchannel 2 | "BrowserChannel server implementation in Clojure." 3 | (:require [ring.middleware.params :as params] 4 | [ring.util.codec :as codec] 5 | [clojure.data.json :as json] 6 | [clojure.string :as str] 7 | [net.thegeez.async-adapter :as async-adapter]) 8 | (:import [java.util.concurrent ScheduledExecutorService Executors TimeUnit Callable ScheduledFuture])) 9 | ;; @todo: out of order acks and maps - AKH the maps at least is taken care of. 10 | ;; @todo use a more specific Exception for failing writes, which 11 | ;; indicate closed connection 12 | ;; @todo SSL in jetty-async-adapter 13 | ;; @todo session-timeout should deduct waiting time for the failed 14 | ;; sent heartbeat? 15 | 16 | (def default-options 17 | {;; a.example, b.example => ["a","b"] 18 | :host-prefixes [] 19 | ;; straight from google 20 | :headers {"Content-Type" "text/plain" 21 | "Cache-Control" "no-cache, no-store, max-age=0, must-revalidate" 22 | "Pragma" "no-cache" 23 | "Expires" "Fri, 01 Jan 1990 00:00:00 GMT" 24 | "X-Content-Type-Options" "nosniff" 25 | } 26 | :base "/channel" ;; root for /test and /bind urls 27 | :keep-alive-interval 30 ;; seconds, keep less than session-time-out 28 | :session-timeout-interval 120 ;; seconds 29 | ;; after this number of bytes a 30 | ;; backchannel will always be closed 31 | :data-threshold (* 10 1024) 32 | }) 33 | 34 | 35 | (def noop-string "[\"noop\"]") 36 | 37 | ;; almost all special cases are for making this work with IE 38 | (def ie-headers 39 | {"Content-Type" "text/html"}) 40 | 41 | ;; appended to first write to ie to prevent whole page buffering 42 | (def ie-stream-padding "7cca69475363026330a0d99468e88d23ce95e222591126443015f5f462d9a177186c8701fb45a6ffee0daf1a178fc0f58cd309308fba7e6f011ac38c9cdd4580760f1d4560a84d5ca0355ecbbed2ab715a3350fe0c479050640bd0e77acec90c58c4d3dd0f5cf8d4510e68c8b12e087bd88cad349aafd2ab16b07b0b1b8276091217a44a9fe92fedacffff48092ee693af\n") 43 | 44 | ;;;;; Utils 45 | ;; to create session ids 46 | (defn uuid [] (str (java.util.UUID/randomUUID))) 47 | 48 | (def scheduler (Executors/newScheduledThreadPool 1)) 49 | 50 | ;; scheduling a task returns a ScheduledFuture, which can be stopped 51 | ;; with (.cancel task false) false says not to interrupt running tasks 52 | (defn schedule [^Callable f ^long secs] 53 | (.schedule ^ScheduledExecutorService scheduler f secs TimeUnit/SECONDS)) 54 | 55 | ;; json responses are sent as "size-of-response\njson-response" 56 | (defn size-json-str [^String json] 57 | (let [size (alength (.getBytes json "UTF-8"))] 58 | (str size "\n" json))) 59 | 60 | ;; make sure the root URI for channels starts with a / for route matching 61 | (defn standard-base [s] 62 | (let [wofirst (if (= \/ (first s)) 63 | (apply str (rest s)) 64 | s) 65 | wolast (if (= \/ (last wofirst)) 66 | (apply str (butlast wofirst)) 67 | wofirst)] 68 | (str "/" wolast))) 69 | 70 | ;; @todo to test file 71 | (assert (= (repeat 4 "/foo") 72 | (map standard-base ["foo" "/foo" "foo/" "/foo"]))) 73 | 74 | ;; type preserving drop upto for queueus 75 | (defn drop-queue [queue id] 76 | (let [head (peek queue)] 77 | (if-not head 78 | queue 79 | (if (< id (first head)) 80 | queue 81 | (recur (pop queue) id))))) 82 | 83 | 84 | ;; Key value pairs do not always come ordered by request number. 85 | ;; E.g. {req0_key1 val01, req1_key1 val11, req0_key2 val02, req1_key2 val12} 86 | (defn transform-url-data [data] 87 | (let [ofs (get data "ofs" "0") 88 | pieces (dissoc data "count" "ofs")] 89 | {:ofs (Long/parseLong ofs) 90 | :maps (->> (for [[k v] pieces] 91 | (let [[_ n k] (re-find #"req(\d+)_(\w+)" k)] 92 | [(Long/parseLong n) {k v}])) 93 | (group-by first) ; {0 [[0 [k1 v2]] [0 [k2 v2]]],1 [[1 [k1 v1]] [1 [k2 v2]]]} 94 | (sort-by first) ;; order by request number so that messages are recieved on server in same order 95 | (map #(into {} (map second (val %)))))})) 96 | 97 | (assert (= {:ofs 0 :maps [{"x" "3" "y" "10"} {"abc" "def"}]} 98 | (transform-url-data {"count" "2" 99 | "ofs" "0" 100 | "req0_x" "3" 101 | "req0_y" "10" 102 | "req1_abc" "def"}))) 103 | ;; maps are URL Encoded 104 | ;;;; URL Encoded data: 105 | ;;{ count: '2', 106 | ;; ofs: '0', 107 | ;; req0_x: '3', 108 | ;; req0_y: '10', 109 | ;; req1_abc: 'def' 110 | ;;} 111 | ;;as :form-params in req: 112 | ;;{"count" "2" 113 | ;; "ofs" "0" 114 | ;; "req0_x" "3" 115 | ;; "req0_y" "10" 116 | ;; "req1_abc" "def"} 117 | ;; => 118 | ;;{:ofs 0 :maps [{"x" "3" "y" "10"},{"abc": "def"}]} 119 | (defn get-maps [req] 120 | (let [data (:form-params req)] 121 | (when-not (zero? (count data)) 122 | ;; number of entries in form-params, 123 | ;; not (get "count" (:form-params req)) 124 | ;; @todo "count" is currently not used to verify the number of 125 | ;; parsed maps 126 | (:maps (transform-url-data data))))) 127 | 128 | ;; rather crude but straight from google 129 | (defn error-response [status-code message] 130 | {:status status-code 131 | :body (str "

" message "

")}) 132 | 133 | (defn agent-error-handler-fn 134 | "Prints the error and tries to restart the agent." 135 | [id] 136 | (fn [ag ^Exception e] 137 | (println "ERROR:" id "agent threw" e (.getMessage e)))) 138 | 139 | ;;;;;; end of utils 140 | 141 | ;;;; listeners 142 | ;; @todo clean this up, perhaps store listeners in the session? 143 | ;; @todo replace with lamina? 144 | ;; sessionId -> :event -> [call back] 145 | ;; event: :map | :close 146 | (def listeners-agent (agent {})) 147 | (set-error-handler! listeners-agent (agent-error-handler-fn "listener")) 148 | (set-error-mode! listeners-agent :continue) 149 | 150 | 151 | (defn add-listener [session-id event-key f] 152 | (send-off listeners-agent 153 | update-in [session-id event-key] #(conj (or % []) f))) 154 | 155 | (defn notify-listeners [session-id request event-key & data] 156 | (send-off listeners-agent 157 | (fn [listeners] 158 | (doseq [callback (get-in listeners [session-id event-key])] 159 | (apply callback request data)) 160 | listeners))) 161 | ;; end of listeners 162 | 163 | ;; Wrapper around writers on continuations 164 | ;; the write methods raise an Exception with the wrapped response in closed 165 | ;; @todo use a more specific Exception 166 | (defprotocol IResponseWrapper 167 | (write-head [this]) 168 | (write [this data]) 169 | (write-raw [this data]) 170 | (write-end [this])) 171 | 172 | ;; for writing on backchannel to non-IE clients 173 | (deftype XHRWriter [;; respond calls functions on the continuation 174 | respond 175 | headers] 176 | IResponseWrapper 177 | (write-head [this] 178 | (async-adapter/head respond 200 headers)) 179 | (write [this data] 180 | (write-raw this (size-json-str data))) 181 | (write-raw [this data] 182 | (async-adapter/write-chunk respond data)) 183 | (write-end [this] 184 | (async-adapter/close respond))) 185 | 186 | ;; for writing on backchannels to IE clients 187 | (deftype IEWriter [;; respond calls functions on the continuation 188 | respond 189 | headers 190 | ;; DOMAIN value from query string 191 | domain 192 | ;; first write requires padding, 193 | ;; padding-sent is a flag for the first time 194 | ^{:volatile-mutable true} write-padding-sent 195 | ;; likewise for write raw, used during test phase 196 | ^{:volatile-mutable true} write-raw-padding-sent] 197 | IResponseWrapper 198 | (write-head [this] 199 | (async-adapter/head respond 200 (merge headers ie-headers)) 200 | (async-adapter/write-chunk respond "\n") 201 | (when (seq domain) 202 | (async-adapter/write-chunk respond (str "\n")))) 203 | (write [this data] 204 | (async-adapter/write-chunk respond (str "\n")) 205 | (when-not write-padding-sent 206 | (async-adapter/write-chunk respond ie-stream-padding) 207 | (set! write-padding-sent true))) 208 | (write-raw [this data] 209 | (async-adapter/write-chunk respond (str "\n")) 210 | (when-not write-raw-padding-sent 211 | (async-adapter/write-chunk respond ie-stream-padding) 212 | (set! write-raw-padding-sent true))) 213 | (write-end [this] 214 | (async-adapter/write-chunk respond "\n") 215 | (async-adapter/close respond))) 216 | 217 | ;;ArrayBuffer 218 | ;;buffer of [[id_lowest data] ... [id_highest data]] 219 | (defprotocol IArrayBuffer 220 | (queue [this string]) 221 | (acknowledge-id [this id]) 222 | (to-flush [this]) 223 | (last-acknowledged-id [this]) 224 | (outstanding-bytes [this]) 225 | ) 226 | 227 | (deftype ArrayBuffer [;; id of the last array that is conj'ed, can't 228 | ;; always be derived because flush buffer might 229 | ;; be empty 230 | array-id 231 | 232 | ;; needed for session status 233 | last-acknowledged-id 234 | 235 | ;; array that have been flushed, but not yet 236 | ;; acknowledged, does not contain noop messages 237 | to-acknowledge-arrays 238 | 239 | ;; arrays to be sent out, may contain arrays 240 | ;; that were in to-acknowledge-arrays but queued 241 | ;; again for resending 242 | to-flush-arrays 243 | ] 244 | IArrayBuffer 245 | (queue [this string] 246 | (let [next-array-id (inc array-id)] 247 | (ArrayBuffer. next-array-id 248 | last-acknowledged-id 249 | to-acknowledge-arrays 250 | (conj to-flush-arrays [next-array-id string])))) 251 | 252 | ;; id may cause the following splits: 253 | ;; normal case: 254 | ;; ack-arrs flush-arrs 255 | ;; client is slow case: 256 | ;; ack-arrs ack-arrs flush-arrs 257 | ;; after arrays have been requeued: 258 | ;; ack-arrs flush-arrs flush-arrs 259 | ;; everything before id can be discarded, everything after id 260 | ;; becomes new flush-arrs and is resend 261 | (acknowledge-id [this id] 262 | (ArrayBuffer. array-id 263 | id 264 | clojure.lang.PersistentQueue/EMPTY 265 | (into (drop-queue to-acknowledge-arrays id) 266 | (drop-queue to-flush-arrays id)))) 267 | 268 | ;; return [seq-to-flush-array next-array-buffer] or nil if 269 | ;; to-flush-arrays is empty 270 | (to-flush [this] 271 | (when-let [to-flush (seq to-flush-arrays)] 272 | [to-flush (ArrayBuffer. array-id 273 | last-acknowledged-id 274 | (into to-acknowledge-arrays 275 | (remove (fn [[id string]] 276 | (= string noop-string)) 277 | to-flush)) 278 | clojure.lang.PersistentQueue/EMPTY)])) 279 | (last-acknowledged-id [this] 280 | last-acknowledged-id) 281 | ;; the sum of all the data that is still to be send 282 | (outstanding-bytes [this] 283 | (reduce + 0 (map (comp count second) to-flush-arrays)))) 284 | 285 | ;; {sessionId -> (agent session)} 286 | (def sessions (atom {})) 287 | 288 | ;; All methods meant to be fn send to an agent, therefor all need to return a Session 289 | (defprotocol ISession 290 | ;; a session spans multiple connections, the connections for the 291 | ;; backward channel is the backchannel of a session 292 | (clear-back-channel [this]) 293 | (set-back-channel [this 294 | ;; respond is a wrapper of the continuation 295 | respond 296 | request]) 297 | 298 | ;; messages sent from server to client are arrays 299 | ;; the client acknowledges received arrays when creating a new backwardchannel 300 | (acknowledge-arrays [this array-ids]) 301 | 302 | (queue-string [this string]) 303 | 304 | ;; heartbeat is a timer to send noop over the backward channel 305 | (clear-heartbeat [this]) 306 | (refresh-heartbeat [this]) 307 | 308 | ;; after a backward channel closes the session is kept alive, so 309 | ;; the client can reconnect. If there is no reconnect before 310 | ;; session-timeout the session is closed 311 | (clear-session-timeout [this]) 312 | (refresh-session-timeout [this]) 313 | 314 | ;; try to send data to the client over the backchannel. 315 | ;; if there is no backchannel, then nothing happens 316 | (flush-buffer [this]) 317 | 318 | ;; after close this session cannot be reconnected to. 319 | ;; removes session for sessions 320 | (close [this request message])) 321 | 322 | (defrecord BackChannel [;; respond wraps the continuation, which is 323 | ;; the actual connection of the backward 324 | ;; channel to the client 325 | respond 326 | ;; when true use streaming 327 | chunk 328 | ;; this is used for diagnostic purposes by the client 329 | bytes-sent]) 330 | 331 | (defn to-pair [p] (str "[" (first p) "," (second p) "]")) 332 | 333 | (defrecord Session [;; must be unique 334 | id 335 | 336 | ;; {:address 337 | ;; :headers 338 | ;; :app-version 339 | ;; :heartbeat-interval 340 | ;; :session-timeout-interval 341 | ;; :data-threshold 342 | ;;} 343 | details 344 | 345 | ;; back-channel might be nil, as a session spans 346 | ;; multiple connections 347 | back-channel 348 | 349 | ;; ArrayBuffer 350 | array-buffer 351 | 352 | ;; ScheduleTask or nil 353 | heartbeat-timeout 354 | 355 | ;; ScheduleTask or nil 356 | ;; when the backchannel is closed from this 357 | ;; session, the session is only removes when this 358 | ;; timer expires during this time the client can 359 | ;; reconnect to its session 360 | session-timeout] 361 | ISession 362 | (clear-back-channel [this] 363 | (try 364 | (when back-channel 365 | (write-end (:respond back-channel))) 366 | (catch Exception e 367 | nil ;; close back channel regardless 368 | )) 369 | (-> this 370 | clear-heartbeat 371 | (assoc :back-channel nil) 372 | refresh-session-timeout)) 373 | (set-back-channel [this respond req] 374 | (let [bc (BackChannel. respond 375 | ;; can we stream responses 376 | ;; back? 377 | ;; CI is determined client 378 | ;; side with /test 379 | (= (get-in req [:query-params "CI"]) "0") 380 | ;; no bytes sent yet 381 | 0)] 382 | (-> this 383 | clear-back-channel 384 | ;; clear-back-channel sets the session-timeout 385 | ;; here we know the session is alive and 386 | ;; well due to this new backchannel 387 | clear-session-timeout 388 | (assoc :back-channel bc) 389 | refresh-heartbeat 390 | ;; try to send any data that was buffered 391 | ;; while there was no backchannel 392 | flush-buffer))) 393 | (clear-heartbeat [this] 394 | (when heartbeat-timeout 395 | (.cancel ^ScheduledFuture heartbeat-timeout 396 | false ;; do not interrupt running tasks 397 | )) 398 | (assoc this :heartbeat-timeout nil)) 399 | (refresh-heartbeat [this] 400 | (-> this 401 | clear-heartbeat 402 | (assoc :heartbeat-timeout 403 | ;; *agent* not bound when executed later 404 | ;; through schedule, therefor passed explicitly 405 | (let [session-agent *agent*] 406 | (schedule (fn [] 407 | (send-off session-agent #(-> % 408 | (queue-string noop-string) 409 | flush-buffer))) 410 | (:heartbeat-interval details)))))) 411 | (clear-session-timeout [this] 412 | (when session-timeout 413 | (.cancel ^ScheduledFuture session-timeout 414 | false ;; do not interrupt running tasks 415 | )) 416 | (assoc this :session-timeout nil)) 417 | (refresh-session-timeout [this] 418 | (-> this 419 | clear-session-timeout 420 | (assoc :session-timeout 421 | (let [session-agent *agent*] 422 | (schedule (fn [] 423 | (send-off session-agent close nil "Timed out")) 424 | (:session-timeout-interval details)))))) 425 | (queue-string [this string] 426 | (update-in this [:array-buffer] queue string)) 427 | (acknowledge-arrays [this array-id] 428 | (let [array-id (Long/parseLong array-id)] 429 | (update-in this [:array-buffer] acknowledge-id array-id))) 430 | ;; tries to do the actual writing to the client 431 | ;; @todo the composition is a bit awkward in this method due to the 432 | ;; try catch and if mix 433 | (flush-buffer [this] 434 | (if-not back-channel 435 | this ;; nothing to do when there's no connection 436 | ;; only flush unacknowledged arrays 437 | (if-let [[to-flush next-array-buffer] (to-flush array-buffer)] 438 | (try 439 | ;; buffer contains [[1 json-str] ...] can't use 440 | ;; json-str which will double escape the json 441 | 442 | (doseq [p to-flush #_(next to-flush)] 443 | (write (:respond back-channel) (str "[" (to-pair p) "]"))) 444 | 445 | ;; size is an approximation 446 | (let [this (let [size (reduce + 0 (map count (map second to-flush)))] 447 | (-> this 448 | (assoc :array-buffer next-array-buffer) 449 | (update-in [:back-channel :bytes-sent] + size))) 450 | ;; clear-back-channel closes the back 451 | ;; channel when the channel does not 452 | ;; support streaming or when a large 453 | ;; amount of data has been sent 454 | this (if (or (not (get-in this [:back-channel :chunk])) 455 | (< (:data-threshold details) (get-in this [:back-channel :bytes-sent]))) 456 | (clear-back-channel this) 457 | this)] 458 | ;; this sending of data keeps the connection alive 459 | ;; make a new heartbeat 460 | (refresh-heartbeat this)) 461 | (catch Exception e 462 | ;; when write failed 463 | ;; non delivered arrays are still in buffer 464 | (clear-back-channel this) 465 | )) 466 | this ;; do nothing if buffer is empty 467 | ))) 468 | ;; closes the session and removes it from sessions 469 | (close [this request message] 470 | 471 | (-> this 472 | clear-back-channel 473 | clear-session-timeout 474 | ;; the heartbeat timeout is cancelled by clear-back-channel 475 | ) 476 | (swap! sessions dissoc id) 477 | (notify-listeners id request :close message) 478 | nil ;; the agent will no longer wrap a session 479 | )) 480 | 481 | ;; creates a session agent wrapping session data and 482 | ;; adds the session to sessions 483 | (defn create-session-agent [req options] 484 | (let [{initial-rid "RID" ;; identifier for forward channel 485 | app-version "CVER" ;; client can specify a custom app-version 486 | old-session-id "OSID" 487 | old-array-id "OAID"} (:query-params req)] 488 | ;; when a client specifies and old session id then that old one 489 | ;; needs to be removed 490 | (when-let [old-session-agent (@sessions old-session-id)] 491 | (send-off old-session-agent #(-> (if old-array-id 492 | (acknowledge-arrays % old-array-id) 493 | %) 494 | (close req "Reconnected")))) 495 | (let [id (uuid) 496 | details {:address (:remote-addr req) 497 | :headers (:headers req) 498 | :app-version app-version 499 | :heartbeat-interval (:keep-alive-interval options) 500 | :session-timeout-interval (:session-timeout-interval options) 501 | :data-threshold (:data-threshold options)} 502 | session (-> (Session. id 503 | details 504 | nil ;; backchannel 505 | (ArrayBuffer. 506 | 0 ;; array-id, 0 is never used by the 507 | ;; array-buffer, it is used by the 508 | ;; first message with the session id 509 | 0 ;; last-acknowledged-id 510 | ;; to-acknowledge-arrays 511 | clojure.lang.PersistentQueue/EMPTY 512 | ;; to-flush-arrays 513 | clojure.lang.PersistentQueue/EMPTY) 514 | nil ;; heartbeat-timeout 515 | nil ;; session-timeout 516 | ) 517 | ;; this first session-timeout is for the case 518 | ;; when the client never connects with a backchannel 519 | refresh-session-timeout) 520 | session-agent (agent session)] 521 | (set-error-handler! session-agent (agent-error-handler-fn (str "session-" (:id session)))) 522 | (set-error-mode! session-agent :continue) 523 | (swap! sessions assoc id session-agent) 524 | (when-let [notify (:on-session options)] 525 | (notify id req)) 526 | session-agent))) 527 | 528 | (defn session-status [session] 529 | (let [has-back-channel (if (:back-channel session) 1 0) 530 | array-buffer (:array-buffer session)] 531 | [has-back-channel (last-acknowledged-id array-buffer) (outstanding-bytes array-buffer)])) 532 | 533 | ;; convience function to send data to a session 534 | ;; the data will be queued until there is a backchannel to send it 535 | ;; over 536 | (defn send-string [session-id string] 537 | (when-let [session-agent (get @sessions session-id)] 538 | (send-off session-agent #(-> % 539 | (queue-string string) 540 | flush-buffer)))) 541 | 542 | (defn send-map [session-id map] 543 | (send-string session-id (json/write-str map))) 544 | 545 | ;; wrap the respond function from :reactor with the proper 546 | ;; responsewrapper for either IE or other clients 547 | (defn wrap-continuation-writers [handler options] 548 | (fn [req] 549 | (let [res (handler req)] 550 | (if (:async res) 551 | (let [reactor (:reactor res) 552 | type (get-in req [:query-params "TYPE"])] 553 | (assoc res :reactor 554 | (fn [respond] 555 | (reactor (let [headers (assoc (:headers options) 556 | "Transfer-Encoding" "chunked")] 557 | (if (= type "html") 558 | (let [domain (get-in req [:query-params "DOMAIN"])] 559 | ;; last two false are the padding 560 | ;; sent flags 561 | (IEWriter. respond headers domain false false)) 562 | (XHRWriter. respond headers))))))) 563 | res ;; do not touch responses without :async 564 | )))) 565 | 566 | ;; test channel is used to determine which host to connect to 567 | ;; and if the connection can support streaming 568 | (defn handle-test-channel [req options] 569 | (if-not (= "8" (get-in req [:query-params "VER"])) 570 | (error-response 400 "Version 8 required") 571 | ;; phase 1 572 | ;; client requests [random host-prefix or 573 | ;; nil,blockedPrefix] 574 | ;; blockedPrefix not supported, always nil 575 | (if (= (get-in req [:query-params "MODE"]) "init") 576 | (let [host-prefix (when-let [prefixes (seq (:host-prefixes options))] 577 | (rand-nth prefixes))] 578 | {:status 200 579 | :headers (assoc (:headers options) "X-Accept" "application/json; application/x-www-form-urlencoded") 580 | :body (json/write-str [host-prefix,nil])}) 581 | 582 | ;; else phase 2 for get /test 583 | ;; client checks if connection is buffered 584 | ;; send 11111, wait 2 seconds, send 2 585 | ;; if client gets two chunks, then there is no buffering 586 | ;; proxy in the way 587 | {:async :http 588 | :reactor 589 | (fn [respond] 590 | (write-head respond) 591 | (write-raw respond "11111") 592 | (schedule #(do (write-raw respond "2") 593 | (write-end respond)) 594 | 2))}))) 595 | 596 | ;; POST req client -> server is a forward channel 597 | ;; session might be nil, when this is the first POST by client 598 | (defn handle-forward-channel [req session-agent options] 599 | (let [[session-agent is-new-session] (if session-agent 600 | [session-agent false] 601 | [(create-session-agent req options) true]) 602 | ;; maps contains whatever the messages to the server 603 | maps (get-maps req)] 604 | (if is-new-session 605 | ;; first post after a new session is a message with the session 606 | ;; details. 607 | ;; response is first array sent for this session: 608 | ;; [[0,["c", session-id, host-prefix, version (always 8)]]] 609 | ;; send as json for XHR and IE 610 | (let [session @session-agent 611 | session-id (:id session) 612 | ;; @todo extract the used host-prefix from the request if any 613 | host-prefix nil] 614 | {:status 200 615 | :headers (assoc (:headers options) "Content-Type" "application/javascript") 616 | :body 617 | (size-json-str (json/write-str [[0,["c", session-id, host-prefix, 8]]]))}) 618 | ;; For existing sessions: 619 | ;; Forward sent data by client to listeners 620 | ;; reply with 621 | ;; [backchannelPresent,lastPostResponseArrayId_,numOutstandingBackchannelBytes] 622 | ;; backchannelPresent = 0 for false, 1 for true 623 | ;; send as json for XHR and IE 624 | (do 625 | (doseq [map maps] 626 | (notify-listeners (:id @session-agent) req :map map)) 627 | (let [status (session-status @session-agent)] 628 | {:status 200 629 | :headers (:headers options) 630 | :body (size-json-str (json/write-str status))}))))) 631 | 632 | ;; GET req server->client is a backwardchannel opened by client 633 | (defn handle-backward-channel [req session-agent options] 634 | (let [type (get-in req [:query-params "TYPE"])] 635 | (cond 636 | (#{"xmlhttp" "html"} type) 637 | ;; @todo check that query RID is "rpc" 638 | {:async :http 639 | :reactor 640 | (fn [respond] 641 | (write-head respond) 642 | (send-off session-agent set-back-channel respond req))} 643 | (= type "terminate") 644 | ;; this is a request made in an img tag 645 | (do ;;end session 646 | (when session-agent 647 | (send-off session-agent close req "Disconnected")) 648 | {:status 200 649 | :headers (:headers options) 650 | :body ""} 651 | )))) 652 | 653 | ;; get to //bind is client->server msg 654 | ;; post to //bind is initiate server->client channel 655 | (defn handle-bind-channel [req options] 656 | (let [SID (get-in req [:query-params "SID"]) 657 | ;; session-agent might be nil, then it will be created by 658 | ;; handle-forward-channel 659 | session-agent (@sessions SID)] 660 | (if (and SID 661 | (not session-agent)) 662 | ;; SID refers to an already created session, which therefore 663 | ;; must exist 664 | (error-response 400 "Unknown SID") 665 | (do 666 | ;; client can tell the server which array it has seen 667 | ;; up to including AID can be removed from the buffer 668 | (when session-agent 669 | (when-let [AID (get-in req [:query-params "AID"])] 670 | (send-off session-agent acknowledge-arrays AID))) 671 | (condp = (:request-method req) 672 | :post (handle-forward-channel req session-agent options) 673 | :get (handle-backward-channel req session-agent options)))))) 674 | 675 | 676 | ;; see default-options for describtion of options 677 | (defn wrap-browserchannel [handler & [options]] 678 | (let [options (merge default-options options) 679 | base (str (:base options))] 680 | (-> (fn [req] 681 | (let [uri ^String (:uri req) 682 | method (:request-method req)] 683 | (cond 684 | (and (.startsWith uri (str base "/test")) 685 | (= method :get)) 686 | (handle-test-channel req options) 687 | (.startsWith uri (str base "/bind")) 688 | (handle-bind-channel req options) 689 | :else (handler req)))) 690 | (wrap-continuation-writers options) 691 | params/wrap-params 692 | ))) 693 | -------------------------------------------------------------------------------- /test/.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | *.jar 7 | *.class 8 | .lein-deps-sum 9 | .lein-failures 10 | .lein-plugins 11 | notes 12 | -------------------------------------------------------------------------------- /test/README.md: -------------------------------------------------------------------------------- 1 | # test 2 | 3 | Beginnings of a test suite for [clj-browserchannel][1]. Uses the 4 | [clj-webdriver][2] Selenium wrapper to launch and interact with 5 | browsers. Actors send messages through the demo chat application and 6 | may introduce connection failures. The test checks whether all messages 7 | were still received. 8 | 9 | [1]:https://github.com/thegeez/clj-browserchannel 10 | [2]:https://github.com/semperos/clj-webdriver/ 11 | 12 | ## About 13 | 14 | Written by: 15 | Gijs Stuurman / [@thegeez][twt] / [Blog][blog] / [GitHub][github] 16 | 17 | [twt]: http://twitter.com/thegeez 18 | [blog]: http://thegeez.github.com 19 | [github]: https://github.com/thegeez 20 | 21 | ### License 22 | 23 | Copyright (c) 2012 Gijs Stuurman and released under an MIT license. 24 | 25 | -------------------------------------------------------------------------------- /test/project.clj: -------------------------------------------------------------------------------- 1 | (defproject test "0.0.1-SNAPSHOT" 2 | :dependencies [[org.clojure/clojure "1.5.1"] 3 | [clj-webdriver "0.6.0"]]) 4 | -------------------------------------------------------------------------------- /test/src/test/actors.clj: -------------------------------------------------------------------------------- 1 | (ns test.actors 2 | (require [clj-webdriver.core :as w] 3 | [clj-webdriver.wait :as wait])) 4 | 5 | (defmulti web-action (fn [driver action] 6 | (:type action))) 7 | 8 | (defmethod web-action :default [& args] nil) 9 | 10 | (defmethod web-action :say [driver {:keys [msg]}] 11 | (w/input-text (w/find-element driver {:id "msg-input"}) msg) 12 | (w/click (w/find-element driver {:id "send-button"}))) 13 | 14 | (defmethod web-action :kill-get [driver action] 15 | (w/execute-script driver "try{ bc.core.channel.backChannelRequest_.xmlHttp_.xhr_.abort(); } catch (err) {return true;}; return true;" )) 16 | 17 | (defmethod web-action :wait [driver {:keys [time]}] 18 | ;; uhm ja, want to use Thread/sleep but this is handled by the driver 19 | (try (wait/wait-until driver (constantly false) time time) 20 | (catch Exception e ;; should be TimeOutException 21 | true))) 22 | 23 | (defn play-actors [actors] 24 | (let [agents (map (fn [act] 25 | (-> act 26 | (assoc :to-do (:actions act)) 27 | (assoc :driver (w/new-driver (select-keys [:browser] act))) 28 | agent)) actors) 29 | ;; broken down clojure.core/await, because we can't know when 30 | ;; all the sends will be done as they are not all done in this thread 31 | done-talking-latch (java.util.concurrent.CountDownLatch. (count actors))] 32 | ;; launch web-drivers 33 | (doseq [ag agents] 34 | (send ag (fn [{:keys [driver url] :as a}] 35 | (w/to driver url) 36 | a))) 37 | (doall (map await agents)) 38 | (println "All launched") 39 | (doseq [ag agents] 40 | (send ag (fn send-msg [a] 41 | (let [{:keys [driver name to-do]} a] 42 | (if-let [action (first to-do)] 43 | (do 44 | (web-action driver action) 45 | (send *agent* send-msg)) 46 | (.countDown done-talking-latch))) 47 | (update-in a [:to-do] rest))) 48 | ) 49 | (.await done-talking-latch) 50 | (println "All done talking") 51 | (Thread/sleep 10000) 52 | (doseq [ag agents] 53 | (send ag (fn [a] 54 | (let [{:keys [driver name]} a] 55 | ;;(w/execute-script driver "alert(\"LOLOLO\");") 56 | (let [seen-msgs (doall (map w/text (w/find-elements driver [{:id "room"} {:tag :div}])))] 57 | (assoc a :seen-msgs seen-msgs)))))) 58 | (apply await agents) 59 | (Thread/sleep 10000) 60 | (doseq [ag agents] 61 | (send ag (fn [a] 62 | (let [{:keys [driver name]} a] 63 | (w/quit driver))))) 64 | (println "All quit") 65 | (doall (map #(dissoc (deref %) :to-do :driver) agents)))) 66 | 67 | -------------------------------------------------------------------------------- /test/src/test/core.clj: -------------------------------------------------------------------------------- 1 | (ns test.core 2 | (require [test.actors :as actors])) 3 | 4 | (def url "http://localhost:8080/index-dev.html") 5 | 6 | (defn -main [& args] 7 | (let [mario {:name "MARIO" 8 | :actions (for [i (range 10)] 9 | {:type :say :msg (str "MARIO says Hello world! " i)}) 10 | :url url 11 | :browser :firefox} 12 | luigi {:name "LUIGI" 13 | :actions (concat (interleave (for [i (range 5)] 14 | {:type :say :msg (str "LUIGI says Hello world! " i)}) 15 | (repeat {:type :kill-get})) 16 | [{:type :kill-get}] 17 | [{:type :wait :time 30000}] 18 | (interleave (for [i (range 5 10)] 19 | {:type :say :msg (str "LUIGI says Hello world! " i)}) 20 | (repeat {:type :kill-get})) 21 | ) 22 | :url url 23 | :browser :firefox} 24 | actors [mario luigi] 25 | done-actors (actors/play-actors actors)] 26 | (doseq [act1 done-actors 27 | act2 done-actors 28 | :when (not= act1 act2)] 29 | ;; check if every msgs for act1 sort of appears in what act2 30 | ;; recv and is in the correct order 31 | (loop [act1-said (->> act1 32 | :actions 33 | (filter (comp #{:say} :type)) 34 | (map :msg)) 35 | act2-recv (:seen-msgs act2)] 36 | (let [a1 (first act1-said)] 37 | (if (nil? a1) 38 | (println "All messages accounted for" (:name act1) " to " (:name act2)) 39 | (let [[match & others] (drop-while #(not (re-find (re-pattern a1) %)) act2-recv)] 40 | (if match 41 | (do #_(println "act1 said: " a1 " recv by act2 as: " match) 42 | (recur (rest act1-said) others)) 43 | (println "Msg from act1 " (:name act1) " not recv by act2" (:name act2) a1))))))))) 44 | 45 | 46 | 47 | --------------------------------------------------------------------------------