Mercurial > lasercutter

comparison src/clojure/contrib/server_socket.clj @ 10:ef7dbbd6452c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
added clojure source goodness
author Robert McIntyre <rlm@mit.edu>
date Sat, 21 Aug 2010 06:25:44 -0400
parents
children
comparison
equal deleted inserted replaced
9:35cf337adfcf 10:ef7dbbd6452c
1 ;; Copyright (c) Craig McDaniel, Jan 2009. 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 ;; Server socket library - includes REPL on socket
10
11 (ns
12 ^{:author "Craig McDaniel",
13 :doc "Server socket library - includes REPL on socket"}
14 clojure.contrib.server-socket
15 (:import (java.net InetAddress ServerSocket Socket SocketException)
16 (java.io InputStreamReader OutputStream OutputStreamWriter PrintWriter)
17 (clojure.lang LineNumberingPushbackReader))
18 (:use [clojure.main :only (repl)]))
19
20 (defn- on-thread [f]
21 (doto (Thread. ^Runnable f)
22 (.start)))
23
24 (defn- close-socket [^Socket s]
25 (when-not (.isClosed s)
26 (doto s
27 (.shutdownInput)
28 (.shutdownOutput)
29 (.close))))
30
31 (defn- accept-fn [^Socket s connections fun]
32 (let [ins (.getInputStream s)
33 outs (.getOutputStream s)]
34 (on-thread #(do
35 (dosync (commute connections conj s))
36 (try
37 (fun ins outs)
38 (catch SocketException e))
39 (close-socket s)
40 (dosync (commute connections disj s))))))
41
42 (defstruct server-def :server-socket :connections)
43
44 (defn- create-server-aux [fun ^ServerSocket ss]
45 (let [connections (ref #{})]
46 (on-thread #(when-not (.isClosed ss)
47 (try
48 (accept-fn (.accept ss) connections fun)
49 (catch SocketException e))
50 (recur)))
51 (struct-map server-def :server-socket ss :connections connections)))
52
53 (defn create-server
54 "Creates a server socket on port. Upon accept, a new thread is
55 created which calls:
56
57 (fun input-stream output-stream)
58
59 Optional arguments support specifying a listen backlog and binding
60 to a specific endpoint."
61 ([port fun backlog ^InetAddress bind-addr]
62 (create-server-aux fun (ServerSocket. port backlog bind-addr)))
63 ([port fun backlog]
64 (create-server-aux fun (ServerSocket. port backlog)))
65 ([port fun]
66 (create-server-aux fun (ServerSocket. port))))
67
68 (defn close-server [server]
69 (doseq [s @(:connections server)]
70 (close-socket s))
71 (dosync (ref-set (:connections server) #{}))
72 (.close ^ServerSocket (:server-socket server)))
73
74 (defn connection-count [server]
75 (count @(:connections server)))
76
77 ;;;;
78 ;;;; REPL on a socket
79 ;;;;
80
81 (defn- socket-repl [ins outs]
82 (binding [*in* (LineNumberingPushbackReader. (InputStreamReader. ins))
83 *out* (OutputStreamWriter. outs)
84 *err* (PrintWriter. ^OutputStream outs true)]
85 (repl)))
86
87 (defn create-repl-server
88 "create a repl on a socket"
89 ([port backlog ^InetAddress bind-addr]
90 (create-server port socket-repl backlog bind-addr))
91 ([port backlog]
92 (create-server port socket-repl backlog))
93 ([port]
94 (create-server port socket-repl)))