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