aboutsummaryrefslogtreecommitdiff
path: root/modules/server-socket/src/main/clojure
diff options
context:
space:
mode:
authorStuart Sierra <mail@stuartsierra.com>2010-08-07 16:41:53 -0400
committerStuart Sierra <mail@stuartsierra.com>2010-08-07 16:41:53 -0400
commita6a92b9b3d2bfd9a56e1e5e9cfba706d1aeeaae5 (patch)
treef1f3da9887dc2dc557df3282b0bcbd4d701ec593 /modules/server-socket/src/main/clojure
parente7930c85290f77815cdb00a60604feedfa2d0194 (diff)
Split all namespaces into sub-modules.
* Examples and tests have not been copied over. * Clojure test/compile phases are commented out in parent POM. * May require installing parent POM before full build.
Diffstat (limited to 'modules/server-socket/src/main/clojure')
-rw-r--r--modules/server-socket/src/main/clojure/clojure/contrib/server_socket.clj94
1 files changed, 94 insertions, 0 deletions
diff --git a/modules/server-socket/src/main/clojure/clojure/contrib/server_socket.clj b/modules/server-socket/src/main/clojure/clojure/contrib/server_socket.clj
new file mode 100644
index 00000000..edfe461c
--- /dev/null
+++ b/modules/server-socket/src/main/clojure/clojure/contrib/server_socket.clj
@@ -0,0 +1,94 @@
+;; Copyright (c) Craig McDaniel, Jan 2009. All rights reserved.
+;; The use and distribution terms for this software are covered by the
+;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+;; which can be found in the file epl-v10.html at the root of this distribution.
+;; By using this software in any fashion, you are agreeing to be bound by
+;; the terms of this license.
+;; You must not remove this notice, or any other, from this software.
+
+;; Server socket library - includes REPL on socket
+
+(ns
+ ^{:author "Craig McDaniel",
+ :doc "Server socket library - includes REPL on socket"}
+ clojure.contrib.server-socket
+ (:import (java.net InetAddress ServerSocket Socket SocketException)
+ (java.io InputStreamReader OutputStream OutputStreamWriter PrintWriter)
+ (clojure.lang LineNumberingPushbackReader))
+ (:use [clojure.main :only (repl)]))
+
+(defn- on-thread [f]
+ (doto (Thread. ^Runnable f)
+ (.start)))
+
+(defn- close-socket [^Socket s]
+ (when-not (.isClosed s)
+ (doto s
+ (.shutdownInput)
+ (.shutdownOutput)
+ (.close))))
+
+(defn- accept-fn [^Socket s connections fun]
+ (let [ins (.getInputStream s)
+ outs (.getOutputStream s)]
+ (on-thread #(do
+ (dosync (commute connections conj s))
+ (try
+ (fun ins outs)
+ (catch SocketException e))
+ (close-socket s)
+ (dosync (commute connections disj s))))))
+
+(defstruct server-def :server-socket :connections)
+
+(defn- create-server-aux [fun ^ServerSocket ss]
+ (let [connections (ref #{})]
+ (on-thread #(when-not (.isClosed ss)
+ (try
+ (accept-fn (.accept ss) connections fun)
+ (catch SocketException e))
+ (recur)))
+ (struct-map server-def :server-socket ss :connections connections)))
+
+(defn create-server
+ "Creates a server socket on port. Upon accept, a new thread is
+ created which calls:
+
+ (fun input-stream output-stream)
+
+ Optional arguments support specifying a listen backlog and binding
+ to a specific endpoint."
+ ([port fun backlog ^InetAddress bind-addr]
+ (create-server-aux fun (ServerSocket. port backlog bind-addr)))
+ ([port fun backlog]
+ (create-server-aux fun (ServerSocket. port backlog)))
+ ([port fun]
+ (create-server-aux fun (ServerSocket. port))))
+
+(defn close-server [server]
+ (doseq [s @(:connections server)]
+ (close-socket s))
+ (dosync (ref-set (:connections server) #{}))
+ (.close ^ServerSocket (:server-socket server)))
+
+(defn connection-count [server]
+ (count @(:connections server)))
+
+;;;;
+;;;; REPL on a socket
+;;;;
+
+(defn- socket-repl [ins outs]
+ (binding [*in* (LineNumberingPushbackReader. (InputStreamReader. ins))
+ *out* (OutputStreamWriter. outs)
+ *err* (PrintWriter. ^OutputStream outs true)]
+ (repl)))
+
+(defn create-repl-server
+ "create a repl on a socket"
+ ([port backlog ^InetAddress bind-addr]
+ (create-server port socket-repl backlog bind-addr))
+ ([port backlog]
+ (create-server port socket-repl backlog))
+ ([port]
+ (create-server port socket-repl)))