blob: 77f722e2fa9e419ac17606d30a6ad662d7257616 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
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))
(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)))
|
