abcl.lisp - clic - Clic is an command line interactive client for gopher writte… | |
git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65… | |
Log | |
Files | |
Refs | |
Tags | |
README | |
LICENSE | |
--- | |
abcl.lisp (20212B) | |
--- | |
1 ;;;; New ABCL networking support (replacement to old armedbear.lisp) | |
2 ;;;; Author: Chun Tian (binghe) | |
3 | |
4 ;;;; See LICENSE for licensing information. | |
5 | |
6 (in-package :usocket) | |
7 | |
8 ;;; Java Classes ($*...) | |
9 (defvar $*boolean (jclass "boolean")) | |
10 (defvar $*byte (jclass "byte")) | |
11 (defvar $*byte[] (jclass "[B")) | |
12 (defvar $*int (jclass "int")) | |
13 (defvar $*long (jclass "long")) | |
14 (defvar $*|Byte| (jclass "java.lang.Byte")) | |
15 (defvar $*DatagramChannel (jclass "java.nio.channels.DatagramChannel")) | |
16 (defvar $*DatagramPacket (jclass "java.net.DatagramPacket")) | |
17 (defvar $*DatagramSocket (jclass "java.net.DatagramSocket")) | |
18 (defvar $*Inet4Address (jclass "java.net.Inet4Address")) | |
19 (defvar $*InetAddress (jclass "java.net.InetAddress")) | |
20 (defvar $*InetSocketAddress (jclass "java.net.InetSocketAddress")) | |
21 (defvar $*Iterator (jclass "java.util.Iterator")) | |
22 (defvar $*SelectableChannel (jclass "java.nio.channels.SelectableChannel… | |
23 (defvar $*SelectionKey (jclass "java.nio.channels.SelectionKey")) | |
24 (defvar $*Selector (jclass "java.nio.channels.Selector")) | |
25 (defvar $*ServerSocket (jclass "java.net.ServerSocket")) | |
26 (defvar $*ServerSocketChannel (jclass "java.nio.channels.ServerSocketCha… | |
27 (defvar $*Set (jclass "java.util.Set")) | |
28 (defvar $*Socket (jclass "java.net.Socket")) | |
29 (defvar $*SocketAddress (jclass "java.net.SocketAddress")) | |
30 (defvar $*SocketChannel (jclass "java.nio.channels.SocketChannel")) | |
31 (defvar $*String (jclass "java.lang.String")) | |
32 | |
33 ;;; Java Constructor ($%.../n) | |
34 (defvar $%Byte/0 (jconstructor $*|Byte| $*byte)) | |
35 (defvar $%DatagramPacket/3 (jconstructor $*DatagramPacket $*byte[] $*int… | |
36 (defvar $%DatagramPacket/5 (jconstructor $*DatagramPacket $*byte[] $*int… | |
37 (defvar $%DatagramSocket/0 (jconstructor $*DatagramSocket)) | |
38 (defvar $%DatagramSocket/1 (jconstructor $*DatagramSocket $*int)) | |
39 (defvar $%DatagramSocket/2 (jconstructor $*DatagramSocket $*int $*InetAd… | |
40 (defvar $%InetSocketAddress/1 (jconstructor $*InetSocketAddress $*int)) | |
41 (defvar $%InetSocketAddress/2 (jconstructor $*InetSocketAddress $*InetAd… | |
42 (defvar $%ServerSocket/0 (jconstructor $*ServerSocket)) | |
43 (defvar $%ServerSocket/1 (jconstructor $*ServerSocket $*int)) | |
44 (defvar $%ServerSocket/2 (jconstructor $*ServerSocket $*int $*int)) | |
45 (defvar $%ServerSocket/3 (jconstructor $*ServerSocket $*int $*int $*Inet… | |
46 (defvar $%Socket/0 (jconstructor $*Socket)) | |
47 (defvar $%Socket/2 (jconstructor $*Socket $*InetAddress $*int)) | |
48 (defvar $%Socket/4 (jconstructor $*Socket $*InetAddress $*int $*InetAddr… | |
49 | |
50 ;;; Java Methods ($@...[/Class]/n) | |
51 (defvar $@accept/0 (jmethod $*ServerSocket "accept")) | |
52 (defvar $@bind/DatagramSocket/1 (jmethod $*DatagramSocket "bind" $*Socke… | |
53 (defvar $@bind/ServerSocket/1 (jmethod $*ServerSocket "bind" $*SocketAdd… | |
54 (defvar $@bind/ServerSocket/2 (jmethod $*ServerSocket "bind" $*SocketAdd… | |
55 (defvar $@bind/Socket/1 (jmethod $*Socket "bind" $*SocketAddress)) | |
56 (defvar $@byteValue/0 (jmethod $*|Byte| "byteValue")) | |
57 (defvar $@channel/0 (jmethod $*SelectionKey "channel")) | |
58 (defvar $@close/DatagramSocket/0 (jmethod $*DatagramSocket "close")) | |
59 (defvar $@close/Selector/0 (jmethod $*Selector "close")) | |
60 (defvar $@close/ServerSocket/0 (jmethod $*ServerSocket "close")) | |
61 (defvar $@close/Socket/0 (jmethod $*Socket "close")) | |
62 (defvar $@shutdownInput/Socket/0 (jmethod $*Socket "shutdownInput")) | |
63 (defvar $@shutdownOutput/Socket/0 (jmethod $*Socket "shutdownOutput")) | |
64 (defvar $@configureBlocking/1 (jmethod $*SelectableChannel "configureBlo… | |
65 (defvar $@connect/DatagramChannel/1 (jmethod $*DatagramChannel "connect"… | |
66 (defvar $@connect/Socket/1 (jmethod $*Socket "connect" $*SocketAddress)) | |
67 (defvar $@connect/Socket/2 (jmethod $*Socket "connect" $*SocketAddress $… | |
68 (defvar $@connect/SocketChannel/1 (jmethod $*SocketChannel "connect" $*S… | |
69 (defvar $@getAddress/0 (jmethod $*InetAddress "getAddress")) | |
70 (defvar $@getAllByName/1 (jmethod $*InetAddress "getAllByName" $*String)) | |
71 (defvar $@getByName/1 (jmethod $*InetAddress "getByName" $*String)) | |
72 (defvar $@getChannel/DatagramSocket/0 (jmethod $*DatagramSocket "getChan… | |
73 (defvar $@getChannel/ServerSocket/0 (jmethod $*ServerSocket "getChannel"… | |
74 (defvar $@getChannel/Socket/0 (jmethod $*Socket "getChannel")) | |
75 (defvar $@getAddress/DatagramPacket/0 (jmethod $*DatagramPacket "getAddr… | |
76 (defvar $@getHostName/0 (jmethod $*InetAddress "getHostName")) | |
77 (defvar $@getInetAddress/DatagramSocket/0 (jmethod $*DatagramSocket "get… | |
78 (defvar $@getInetAddress/ServerSocket/0 (jmethod $*ServerSocket "getInet… | |
79 (defvar $@getInetAddress/Socket/0 (jmethod $*Socket "getInetAddress")) | |
80 (defvar $@getLength/DatagramPacket/0 (jmethod $*DatagramPacket "getLengt… | |
81 (defvar $@getLocalAddress/DatagramSocket/0 (jmethod $*DatagramSocket "ge… | |
82 (defvar $@getLocalAddress/Socket/0 (jmethod $*Socket "getLocalAddress")) | |
83 (defvar $@getLocalPort/DatagramSocket/0 (jmethod $*DatagramSocket "getLo… | |
84 (defvar $@getLocalPort/ServerSocket/0 (jmethod $*ServerSocket "getLocalP… | |
85 (defvar $@getLocalPort/Socket/0 (jmethod $*Socket "getLocalPort")) | |
86 (defvar $@getOffset/DatagramPacket/0 (jmethod $*DatagramPacket "getOffse… | |
87 (defvar $@getPort/DatagramPacket/0 (jmethod $*DatagramPacket "getPort")) | |
88 (defvar $@getPort/DatagramSocket/0 (jmethod $*DatagramSocket "getPort")) | |
89 (defvar $@getPort/Socket/0 (jmethod $*Socket "getPort")) | |
90 (defvar $@hasNext/0 (jmethod $*Iterator "hasNext")) | |
91 (defvar $@iterator/0 (jmethod $*Set "iterator")) | |
92 (defvar $@next/0 (jmethod $*Iterator "next")) | |
93 (defvar $@open/DatagramChannel/0 (jmethod $*DatagramChannel "open")) | |
94 (defvar $@open/Selector/0 (jmethod $*Selector "open")) | |
95 (defvar $@open/ServerSocketChannel/0 (jmethod $*ServerSocketChannel "ope… | |
96 (defvar $@open/SocketChannel/0 (jmethod $*SocketChannel "open")) | |
97 (defvar $@receive/1 (jmethod $*DatagramSocket "receive" $*DatagramPacket… | |
98 (defvar $@register/2 (jmethod $*SelectableChannel "register" $*Selector … | |
99 (defvar $@select/0 (jmethod $*Selector "select")) | |
100 (defvar $@select/1 (jmethod $*Selector "select" $*long)) | |
101 (defvar $@selectedKeys/0 (jmethod $*Selector "selectedKeys")) | |
102 (defvar $@send/1 (jmethod $*DatagramSocket "send" $*DatagramPacket)) | |
103 (defvar $@setReuseAddress/1 (jmethod $*ServerSocket "setReuseAddress" $*… | |
104 (defvar $@setSoTimeout/DatagramSocket/1 (jmethod $*DatagramSocket "setSo… | |
105 (defvar $@setSoTimeout/Socket/1 (jmethod $*Socket "setSoTimeout" $*int)) | |
106 (defvar $@setTcpNoDelay/1 (jmethod $*Socket "setTcpNoDelay" $*boolean)) | |
107 (defvar $@socket/DatagramChannel/0 (jmethod $*DatagramChannel "socket")) | |
108 (defvar $@socket/ServerSocketChannel/0 (jmethod $*ServerSocketChannel "s… | |
109 (defvar $@socket/SocketChannel/0 (jmethod $*SocketChannel "socket")) | |
110 (defvar $@validOps/0 (jmethod $*SelectableChannel "validOps")) | |
111 | |
112 ;;; Java Field Variables ($+...) | |
113 (defvar $+op-accept (jfield $*SelectionKey "OP_ACCEPT")) | |
114 (defvar $+op-connect (jfield $*SelectionKey "OP_CONNECT")) | |
115 (defvar $+op-read (jfield $*SelectionKey "OP_READ")) | |
116 (defvar $+op-write (jfield $*SelectionKey "OP_WRITE")) | |
117 | |
118 | |
119 ;;; Wrapper functions (return-type: java-object) | |
120 (defun %get-address (address) | |
121 (jcall $@getAddress/0 address)) | |
122 (defun %get-all-by-name (string) ; return a simple vector | |
123 (jstatic $@getAllByName/1 $*InetAddress string)) | |
124 (defun %get-by-name (string) | |
125 (jstatic $@getByName/1 $*InetAddress string)) | |
126 | |
127 (defun host-to-inet4 (host) | |
128 "USOCKET host formats to Java Inet4Address, used internally." | |
129 (%get-by-name (host-to-hostname host))) | |
130 | |
131 ;;; HANDLE-CONTITION | |
132 | |
133 (defparameter +abcl-error-map+ | |
134 `(("java.net.BindException" . operation-not-permitted-error) | |
135 ("java.net.ConnectException" . connection-refused-error) | |
136 ("java.net.NoRouteToHostException" . network-unreachable-error) ; un… | |
137 ("java.net.PortUnreachableException" . protocol-not-supported-error)… | |
138 ("java.net.ProtocolException" . protocol-not-supported-error) ; unte… | |
139 ("java.net.SocketException" . socket-type-not-supported-error) ; unt… | |
140 ("java.net.SocketTimeoutException" . timeout-error))) | |
141 | |
142 (defparameter +abcl-nameserver-error-map+ | |
143 `(("java.net.UnknownHostException" . ns-host-not-found-error))) | |
144 | |
145 (defun handle-condition (condition &optional (socket nil) (host-or-ip ni… | |
146 (typecase condition | |
147 (java-exception | |
148 (let ((java-cause (java-exception-cause condition))) | |
149 (let* ((usock-error (cdr (assoc (jclass-of java-cause) +abcl-erro… | |
150 :test #'string=))) | |
151 (usock-error (if (functionp usock-error) | |
152 (funcall usock-error condition) | |
153 usock-error)) | |
154 (nameserver-error (cdr (assoc (jclass-of java-cause) +abcl… | |
155 :test #'string=)))) | |
156 (if nameserver-error | |
157 (error nameserver-error :socket socket :host-or-ip host-or-… | |
158 (when usock-error | |
159 (error usock-error :socket socket)))))))) | |
160 | |
161 ;;; GET-HOSTS-BY-NAME | |
162 | |
163 (defun get-address (address) | |
164 (when address | |
165 (let* ((array (%get-address address)) | |
166 (length (jarray-length array))) | |
167 (labels ((jbyte (n) | |
168 (let ((byte (jarray-ref array n))) | |
169 (if (minusp byte) (+ 256 byte) byte)))) | |
170 (cond | |
171 ((= 4 length) | |
172 (vector (jbyte 0) (jbyte 1) (jbyte 2) (jbyte 3))) | |
173 ((= 16 length) | |
174 (vector (jbyte 0) (jbyte 1) (jbyte 2) (jbyte 3) | |
175 (jbyte 4) (jbyte 5) (jbyte 6) (jbyte 7) | |
176 (jbyte 8) (jbyte 9) (jbyte 10) (jbyte 11) | |
177 (jbyte 12) (jbyte 13) (jbyte 14) (jbyte 15))) | |
178 (t nil)))))) ; neither a IPv4 nor IPv6 address?! | |
179 | |
180 (defun get-hosts-by-name (name) | |
181 (with-mapped-conditions (nil name) | |
182 (map 'list #'get-address (%get-all-by-name name)))) | |
183 | |
184 ;;; GET-HOST-BY-ADDRESS | |
185 | |
186 (defun get-host-by-address (host) | |
187 (let ((inet4 (host-to-inet4 host))) | |
188 (with-mapped-conditions (nil host) | |
189 (jcall $@getHostName/0 inet4)))) | |
190 | |
191 ;;; SOCKET-CONNECT | |
192 | |
193 (defun socket-connect (host port &key (protocol :stream) (element-type '… | |
194 timeout deadline (nodelay t nodelay-supplied-p) | |
195 local-host local-port) | |
196 (when deadline (unsupported 'deadline 'socket-connect)) | |
197 (let (socket stream usocket) | |
198 (ecase protocol | |
199 (:stream ; TCP | |
200 (let ((channel (jstatic $@open/SocketChannel/0 $*SocketChannel)) | |
201 (address (jnew $%InetSocketAddress/2 (host-to-inet4 host) p… | |
202 (setq socket (jcall $@socket/SocketChannel/0 channel)) | |
203 ;; bind to local address if needed | |
204 (when (or local-host local-port) | |
205 (let ((local-address (jnew $%InetSocketAddress/2 (host-to-ine… | |
206 (with-mapped-conditions (nil host) | |
207 (jcall $@bind/Socket/1 socket local-address)))) | |
208 ;; connect to dest address | |
209 (with-mapped-conditions (nil host) | |
210 (jcall $@connect/SocketChannel/1 channel address)) | |
211 (setq stream (ext:get-socket-stream socket :element-type elemen… | |
212 usocket (make-stream-socket :stream stream :socket socket… | |
213 (when nodelay-supplied-p | |
214 (jcall $@setTcpNoDelay/1 socket (if nodelay ;; both t and :if… | |
215 java:+true+ java:+false+))) | |
216 (when timeout | |
217 (jcall $@setSoTimeout/Socket/1 socket (truncate (* 1000 timeo… | |
218 (:datagram ; UDP | |
219 (let ((channel (jstatic $@open/DatagramChannel/0 $*DatagramChanne… | |
220 (setq socket (jcall $@socket/DatagramChannel/0 channel)) | |
221 ;; bind to local address if needed | |
222 (when (or local-host local-port) | |
223 (let ((local-address (jnew $%InetSocketAddress/2 (host-to-ine… | |
224 (with-mapped-conditions (nil local-host) | |
225 (jcall $@bind/DatagramSocket/1 socket local-address)))) | |
226 ;; connect to dest address if needed | |
227 (when (and host port) | |
228 (let ((address (jnew $%InetSocketAddress/2 (host-to-inet4 hos… | |
229 (with-mapped-conditions (nil host) | |
230 (jcall $@connect/DatagramChannel/1 channel address)))) | |
231 (setq usocket (make-datagram-socket socket :connected-p (if (an… | |
232 (when timeout | |
233 (jcall $@setSoTimeout/DatagramSocket/1 socket (truncate (* 10… | |
234 usocket)) | |
235 | |
236 ;;; SOCKET-LISTEN | |
237 | |
238 (defun socket-listen (host port &key reuseaddress | |
239 (reuse-address nil reuse-address-supplied-p) | |
240 (backlog 5 backlog-supplied-p) | |
241 (element-type 'character)) | |
242 (declare (type boolean reuse-address)) | |
243 (let* ((reuseaddress (if reuse-address-supplied-p reuse-address reusea… | |
244 (channel (jstatic $@open/ServerSocketChannel/0 $*ServerSocketCh… | |
245 (socket (jcall $@socket/ServerSocketChannel/0 channel)) | |
246 (endpoint (jnew $%InetSocketAddress/2 (host-to-inet4 host) (or … | |
247 (jcall $@setReuseAddress/1 socket (if reuseaddress java:+true+ java:… | |
248 (with-mapped-conditions (socket host) | |
249 (if backlog-supplied-p | |
250 (jcall $@bind/ServerSocket/2 socket endpoint backlog) | |
251 (jcall $@bind/ServerSocket/1 socket endpoint))) | |
252 (make-stream-server-socket socket :element-type element-type))) | |
253 | |
254 ;;; SOCKET-ACCEPT | |
255 | |
256 (defmethod socket-accept ((usocket stream-server-usocket) | |
257 &key (element-type 'character element-type-p)) | |
258 (with-mapped-conditions (usocket) | |
259 (let* ((client-socket (jcall $@accept/0 (socket usocket))) | |
260 (element-type (if element-type-p | |
261 element-type | |
262 (element-type usocket))) | |
263 (stream (ext:get-socket-stream client-socket :element-type el… | |
264 (make-stream-socket :stream stream :socket client-socket)))) | |
265 | |
266 ;;; SOCKET-CLOSE | |
267 | |
268 (defmethod socket-close ((usocket stream-server-usocket)) | |
269 (with-mapped-conditions (usocket) | |
270 (jcall $@close/ServerSocket/0 (socket usocket)))) | |
271 | |
272 (defmethod socket-close ((usocket stream-usocket)) | |
273 (with-mapped-conditions (usocket) | |
274 (close (socket-stream usocket)) | |
275 (jcall $@close/Socket/0 (socket usocket)))) | |
276 | |
277 (defmethod socket-close ((usocket datagram-usocket)) | |
278 (with-mapped-conditions (usocket) | |
279 (jcall $@close/DatagramSocket/0 (socket usocket)))) | |
280 | |
281 (defmethod socket-shutdown ((usocket stream-usocket) direction) | |
282 (with-mapped-conditions (usocket) | |
283 (ecase direction | |
284 (:input | |
285 (jcall $@shutdownInput/Socket/0 (socket usocket))) | |
286 (:output | |
287 (jcall $@shutdownOutput/Socket/0 (socket usocket)))))) | |
288 | |
289 ;;; GET-LOCAL/PEER-NAME/ADDRESS/PORT | |
290 | |
291 (defmethod get-local-name ((usocket usocket)) | |
292 (values (get-local-address usocket) | |
293 (get-local-port usocket))) | |
294 | |
295 (defmethod get-peer-name ((usocket usocket)) | |
296 (values (get-peer-address usocket) | |
297 (get-peer-port usocket))) | |
298 | |
299 (defmethod get-local-address ((usocket stream-usocket)) | |
300 (get-address (jcall $@getLocalAddress/Socket/0 (socket usocket)))) | |
301 | |
302 (defmethod get-local-address ((usocket stream-server-usocket)) | |
303 (get-address (jcall $@getInetAddress/ServerSocket/0 (socket usocket)))) | |
304 | |
305 (defmethod get-local-address ((usocket datagram-usocket)) | |
306 (get-address (jcall $@getLocalAddress/DatagramSocket/0 (socket usocket… | |
307 | |
308 (defmethod get-peer-address ((usocket stream-usocket)) | |
309 (get-address (jcall $@getInetAddress/Socket/0 (socket usocket)))) | |
310 | |
311 (defmethod get-peer-address ((usocket datagram-usocket)) | |
312 (get-address (jcall $@getInetAddress/DatagramSocket/0 (socket usocket)… | |
313 | |
314 (defmethod get-local-port ((usocket stream-usocket)) | |
315 (jcall $@getLocalPort/Socket/0 (socket usocket))) | |
316 | |
317 (defmethod get-local-port ((usocket stream-server-usocket)) | |
318 (jcall $@getLocalPort/ServerSocket/0 (socket usocket))) | |
319 | |
320 (defmethod get-local-port ((usocket datagram-usocket)) | |
321 (jcall $@getLocalPort/DatagramSocket/0 (socket usocket))) | |
322 | |
323 (defmethod get-peer-port ((usocket stream-usocket)) | |
324 (jcall $@getPort/Socket/0 (socket usocket))) | |
325 | |
326 (defmethod get-peer-port ((usocket datagram-usocket)) | |
327 (jcall $@getPort/DatagramSocket/0 (socket usocket))) | |
328 | |
329 ;;; SOCKET-SEND & SOCKET-RECEIVE | |
330 | |
331 (defun *->byte (data) | |
332 (declare (type (unsigned-byte 8) data)) ; required by SOCKET-SEND | |
333 (jnew $%Byte/0 (if (> data 127) (- data 256) data))) | |
334 | |
335 (defun byte->* (byte &optional (element-type '(unsigned-byte 8))) | |
336 (let* ((ub8 (if (minusp byte) (+ 256 byte) byte))) | |
337 (if (eq element-type 'character) | |
338 (code-char ub8) | |
339 ub8))) | |
340 | |
341 (defmethod socket-send ((usocket datagram-usocket) buffer size &key host… | |
342 (let* ((socket (socket usocket)) | |
343 (byte-array (jnew-array $*byte size)) | |
344 (packet (if (and host port) | |
345 (jnew $%DatagramPacket/5 byte-array 0 size (host-to… | |
346 (jnew $%DatagramPacket/3 byte-array 0 size)))) | |
347 ;; prepare sending data | |
348 (loop for i from offset below (+ size offset) | |
349 do (setf (jarray-ref byte-array i) (*->byte (aref buffer i)))) | |
350 (with-mapped-conditions (usocket host) | |
351 (jcall $@send/1 socket packet)))) | |
352 | |
353 ;;; TODO: return-host and return-port cannot be get ... | |
354 (defmethod socket-receive ((usocket datagram-usocket) buffer length | |
355 &key (element-type '(unsigned-byte 8))) | |
356 (declare (values (simple-array (unsigned-byte 8) (*)) ; buffer | |
357 (integer 0) ; size | |
358 (unsigned-byte 32) ; host | |
359 (unsigned-byte 16))) ; port | |
360 (let* ((socket (socket usocket)) | |
361 (real-length (or length +max-datagram-packet-size+)) | |
362 (byte-array (jnew-array $*byte real-length)) | |
363 (packet (jnew $%DatagramPacket/3 byte-array 0 real-length))) | |
364 (with-mapped-conditions (usocket) | |
365 (jcall $@receive/1 socket packet)) | |
366 (let* ((receive-length (jcall $@getLength/DatagramPacket/0 packet)) | |
367 (return-buffer (or buffer (make-array receive-length :element… | |
368 (loop for i from 0 below receive-length | |
369 do (setf (aref return-buffer i) | |
370 (byte->* (jarray-ref byte-array i) element-type))) | |
371 (let ((return-host (if (connected-p usocket) | |
372 (get-peer-address usocket) | |
373 (get-address (jcall $@getAddress/DatagramPa… | |
374 (return-port (if (connected-p usocket) | |
375 (get-peer-port usocket) | |
376 (jcall $@getPort/DatagramPacket/0 packet)))) | |
377 (values return-buffer | |
378 receive-length | |
379 return-host | |
380 return-port))))) | |
381 | |
382 ;;; WAIT-FOR-INPUT | |
383 | |
384 (defun socket-channel-class (usocket) | |
385 (cond ((stream-usocket-p usocket) $*SocketChannel) | |
386 ((stream-server-usocket-p usocket) $*ServerSocketChannel) | |
387 ((datagram-usocket-p usocket) $*DatagramChannel))) | |
388 | |
389 (defun get-socket-channel (usocket) | |
390 (let ((method (cond ((stream-usocket-p usocket) $@getChannel/Socket/0) | |
391 ((stream-server-usocket-p usocket) $@getChannel/Se… | |
392 ((datagram-usocket-p usocket) $@getChannel/Datagra… | |
393 (jcall method (socket usocket)))) | |
394 | |
395 (defun wait-for-input-internal (wait-list &key timeout) | |
396 (let* ((sockets (wait-list-waiters wait-list)) | |
397 (ops (logior $+op-read $+op-accept)) | |
398 (selector (jstatic $@open/Selector/0 $*Selector)) | |
399 (channels (mapcar #'get-socket-channel sockets))) | |
400 (unwind-protect | |
401 (with-mapped-conditions () | |
402 (dolist (channel channels) | |
403 (jcall $@configureBlocking/1 channel java:+false+) | |
404 (jcall $@register/2 channel selector (logand ops (jcall $@v… | |
405 (let ((ready-count (if timeout | |
406 (jcall $@select/1 selector (truncate (… | |
407 (jcall $@select/0 selector)))) | |
408 (when (plusp ready-count) | |
409 (let* ((keys (jcall $@selectedKeys/0 selector)) | |
410 (iterator (jcall $@iterator/0 keys)) | |
411 (%wait (wait-list-%wait wait-list))) | |
412 (loop while (jcall $@hasNext/0 iterator) | |
413 do (let* ((key (jcall $@next/0 iterator)) | |
414 (channel (jcall $@channel/0 key))) | |
415 (setf (state (gethash channel %wait)) :read)… | |
416 (jcall $@close/Selector/0 selector) | |
417 (dolist (channel channels) | |
418 (jcall $@configureBlocking/1 channel java:+true+))))) | |
419 | |
420 ;;; WAIT-LIST | |
421 | |
422 ;;; NOTE from original worker (Erik): | |
423 ;;; Note that even though Java has the concept of the Selector class, wh… | |
424 ;;; remotely looks like a wait-list, it requires the sockets to be non-b… | |
425 ;;; usocket however doesn't make any such guarantees and is therefore un… | |
426 ;;; use the concept outside of the waiting routine itself (blergh!). | |
427 | |
428 (defun %setup-wait-list (wl) | |
429 (setf (wait-list-%wait wl) | |
430 (make-hash-table :test #'equal :rehash-size 1.3d0))) | |
431 | |
432 (defun %add-waiter (wl w) | |
433 (setf (gethash (get-socket-channel w) (wait-list-%wait wl)) w)) | |
434 | |
435 (defun %remove-waiter (wl w) | |
436 (remhash (get-socket-channel w) (wait-list-%wait wl))) |