[usocket-cvs] r554 - in usocket/trunk: backend test
Chun Tian (binghe)
ctian at common-lisp.net
Sat Sep 11 13:34:28 UTC 2010
Author: ctian
Date: Sat Sep 11 09:34:27 2010
New Revision: 554
Log:
New ABCL backend using latest JAVA interface.
Added:
usocket/trunk/backend/abcl.lisp (contents, props changed)
usocket/trunk/test/test-condition.lisp (contents, props changed)
Added: usocket/trunk/backend/abcl.lisp
==============================================================================
--- (empty file)
+++ usocket/trunk/backend/abcl.lisp Sat Sep 11 09:34:27 2010
@@ -0,0 +1,202 @@
+;;;; $Id$
+;;;; $URL$
+
+;;;; New ABCL networking support (replacement to old armedbear.lisp)
+;;;; Author: Chun Tian (binghe)
+
+;;;; See LICENSE for licensing information.
+
+(in-package :usocket)
+
+;;; Java Classes ($*...)
+(defvar $*boolean (jclass "boolean"))
+(defvar $*int (jclass "int"))
+(defvar $*DatagramSocket (jclass "java.net.DatagramSocket"))
+(defvar $*Inet4Address (jclass "java.net.Inet4Address"))
+(defvar $*InetAddress (jclass "java.net.InetAddress"))
+(defvar $*InetSocketAddress (jclass "java.net.InetSocketAddress"))
+(defvar $*ServerSocket (jclass "java.net.ServerSocket"))
+(defvar $*Socket (jclass "java.net.Socket"))
+(defvar $*SocketAddress (jclass "java.net.SocketAddress"))
+(defvar $*String (jclass "java.lang.String"))
+
+;;; Java Constructor ($%.../n)
+(defvar $%DatagramSocket/0 (jconstructor $*DatagramSocket))
+(defvar $%InetSocketAddress/1 (jconstructor $*InetSocketAddress $*int))
+(defvar $%InetSocketAddress/2 (jconstructor $*InetSocketAddress $*InetAddress $*int))
+(defvar $%ServerSocket/0 (jconstructor $*ServerSocket))
+(defvar $%ServerSocket/1 (jconstructor $*ServerSocket $*int))
+(defvar $%ServerSocket/2 (jconstructor $*ServerSocket $*int $*int))
+(defvar $%ServerSocket/3 (jconstructor $*ServerSocket $*int $*int $*InetAddress))
+(defvar $%Socket/0 (jconstructor $*Socket))
+(defvar $%Socket/2 (jconstructor $*Socket $*InetAddress $*int))
+(defvar $%Socket/4 (jconstructor $*Socket $*InetAddress $*int $*InetAddress $*int))
+
+;;; Java Methods ($@...[/Class]/n)
+(defvar $@accept/0 (jmethod $*ServerSocket "accept"))
+(defvar $@bind/1 (jmethod $*ServerSocket "bind" $*SocketAddress))
+(defvar $@bind/2 (jmethod $*ServerSocket "bind" $*SocketAddress $*int))
+(defvar $@close/ServerSocket/0 (jmethod $*ServerSocket "close"))
+(defvar $@close/Socket/0 (jmethod $*Socket "close"))
+(defvar $@connect/1 (jmethod $*Socket "connect" $*SocketAddress))
+(defvar $@connect/2 (jmethod $*Socket "connect" $*SocketAddress $*int))
+(defvar $@getAddress/0 (jmethod $*Inet4Address "getAddress"))
+(defvar $@getAllByName/1 (jmethod $*InetAddress "getAllByName" $*String))
+(defvar $@getByName/1 (jmethod $*InetAddress "getByName" $*String))
+(defvar $@getHostName/0 (jmethod $*InetAddress "getHostName"))
+(defvar $@getInetAddress/ServerSocket/0 (jmethod $*ServerSocket "getInetAddress"))
+(defvar $@getInetAddress/Socket/0 (jmethod $*Socket "getInetAddress"))
+(defvar $@getLocalAddress/Socket/0 (jmethod $*Socket "getLocalAddress"))
+(defvar $@getLocalPort/ServerSocket/0 (jmethod $*ServerSocket "getLocalPort"))
+(defvar $@getLocalPort/Socket/0 (jmethod $*Socket "getLocalPort"))
+(defvar $@getPort/Socket/0 (jmethod $*Socket "getPort"))
+(defvar $@setReuseAddress/1 (jmethod $*ServerSocket "setReuseAddress" $*boolean))
+
+;;; Wrapper functions (return-type: java-object)
+(defun %get-address (address)
+ (jcall $@getAddress/0 address))
+(defun %get-all-by-name (string) ; return a simple vector
+ (jstatic $@getAllByName/1 $*InetAddress string))
+(defun %get-by-name (string)
+ (jstatic $@getByName/1 $*InetAddress string))
+
+;;; HANDLE-CONTITION
+
+(defun handle-condition (condition &optional (socket nil))
+ (typecase condition
+ (java-exception
+ (let ((java-cause (java-exception-cause condition)))
+ (let* ((usock-error (cdr (assoc (jclass-of java-cause) +abcl-error-map+
+ :test #'string=)))
+ (usock-error (if (functionp usock-error)
+ (funcall usock-error condition)
+ usock-error))
+ (nameserver-error (cdr (assoc (jclass-of java-cause) +abcl-nameserver-error-map+
+ :test #'string=))))
+ (if nameserver-error
+ (error nameserver-error :host-or-ip nil)
+ (when usock-error
+ (error usock-error :socket socket))))))))
+
+(defparameter +abcl-error-map+
+ `(;("java.io.IOException" . )
+ ("java.net.ConnectException" . connection-refused-error)
+ ("java.net.SocketTimeoutException" . timeout-error)
+ ("java.net.BindException" . operation-not-permitted-error)))
+
+(defparameter +abcl-nameserver-error-map+
+ `(("java.net.UnknownHostException" . ns-host-not-found-error)))
+
+;;; GET-HOSTS-BY-NAME
+
+(defun get-address (address)
+ (let* ((array (%get-address address))
+ (length (jarray-length array)))
+ (labels ((jbyte (n)
+ (let ((byte (jarray-ref array n)))
+ (if (plusp byte)
+ byte
+ (+ 256 byte)))))
+ (if (= 4 length)
+ (vector (jbyte 0) (jbyte 1) (jbyte 2) (jbyte 3))
+ nil)))) ; not a IPv4 address?!
+
+(defun get-hosts-by-name (name)
+ (with-mapped-conditions ()
+ (map 'list #'get-address (%get-all-by-name name))))
+
+(defun host-to-inet4 (host)
+ "USOCKET host formats to Java Inet4Address, used internally."
+ (%get-by-name (host-to-hostname host)))
+
+;;; GET-HOST-BY-ADDRESS
+(defun get-host-by-address (host)
+ (let ((inet4 (host-to-inet4 host)))
+ (with-mapped-conditions ()
+ (jcall $@getHostName/0 inet4))))
+
+;;; SOCKET-CONNECT
+
+(defun socket-connect (host port &key (protocol :stream) (element-type 'character)
+ timeout deadline (nodelay t nodelay-supplied-p)
+ local-host local-port)
+ (declare (type integer timeout))
+ (if (eq protocol :stream)
+ (let* ((socket (with-mapped-conditions ()
+ (if (or local-host local-port)
+ (jnew $%Socket/4 (host-to-inet4 host) port (host-to-inet4 local-host) local-port)
+ (if timeout
+ (let ((socket (jnew $%Socket/0))
+ (address (jnew $%InetSocketAddress/2 (host-to-inet4 host) port)))
+ (jcall $@connect/2 socket address timeout)
+ socket)
+ (jnew $%Socket/2 (host-to-inet4 host) port)))))
+ (stream (ext:get-socket-stream socket :element-type element-type))
+ (usocket (make-stream-socket :stream stream :socket socket)))
+ usocket)
+ (socket-connect-for-udp host port :timeout timeout :local-host local-host :local-port local-port)))
+
+(defun socket-connect-for-udp (host port &key timeout local-host local-port)
+ )
+
+(defun socket-listen (host port &key reuseaddress (element-type 'character)
+ (reuse-address nil reuse-address-supplied-p)
+ (backlog 5 backlog-supplied-p))
+ (let ((socket (jnew $%ServerSocket/0))
+ (endpoint (jnew $%InetSocketAddress/2 (host-to-inet4 host) port)))
+ #+ignore ;; TODO: java.lang.IllegalArgumentException?
+ (when reuse-address-supplied-p
+ (jcall $@setReuseAddress/1 socket reuse-address))
+ (with-mapped-conditions (socket)
+ (if backlog-supplied-p
+ (jcall $@bind/2 socket endpoint backlog)
+ (jcall $@bind/1 socket endpoint)))
+ (make-stream-server-socket socket :element-type element-type)))
+
+(defmethod socket-accept ((socket stream-server-usocket) &key (element-type 'character))
+ (with-mapped-conditions (socket)
+ (let* ((client-socket (jcall $@accept/0 socket))
+ (stream (ext:get-socket-stream client-socket :element-type element-type)))
+ (make-stream-socket :stream stream :socket client-socket))))
+
+(defmethod socket-close :before ((usocket usocket))
+ (when (wait-list usocket)
+ (remove-waiter (wait-list usocket) usocket)))
+
+(defmethod socket-close ((usocket usocket))
+ (with-mapped-conditions (usocket)
+ (jcall $@close/Socket/0 (socket usocket))))
+
+(defmethod socket-close ((usocket stream-server-usocket))
+ (with-mapped-conditions (usocket)
+ (jcall $@close/ServerSocket/0 (socket usocket))))
+
+(defmethod socket-close ((usocket stream-usocket))
+ (with-mapped-conditions (usocket)
+ (close (socket-stream usocket))))
+
+(defmethod get-local-name ((usocket usocket))
+ (values (get-local-address usocket)
+ (get-local-port usocket)))
+
+(defmethod get-peer-name ((usocket stream-usocket))
+ (values (get-peer-address usocket)
+ (get-peer-port usocket)))
+
+(defmethod get-local-address ((usocket usocket))
+ (get-address (jcall $@getLocalAddress/Socket/0 (socket usocket))))
+
+(defmethod get-local-address ((usocket stream-server-usocket))
+ (get-address (jcall $@getInetAddress/ServerSocket/0 (socket usocket))))
+
+(defmethod get-peer-address ((usocket usocket))
+ (get-address (jcall $@getInetAddress/Socket/0 (socket usocket))))
+
+(defmethod get-local-port ((usocket usocket))
+ (jcall $@getLocalPort/Socket/0 (socket usocket)))
+
+(defmethod get-local-port ((usocket stream-server-usocket))
+ (jcall $@getLocalPort/ServerSocket/0 (socket usocket)))
+
+(defmethod get-peer-port ((usocket usocket))
+ (jcall $@getPort/Socket/0 (socket usocket)))
Added: usocket/trunk/test/test-condition.lisp
==============================================================================
--- (empty file)
+++ usocket/trunk/test/test-condition.lisp Sat Sep 11 09:34:27 2010
@@ -0,0 +1,28 @@
+;;;; $Id$
+;;;; $URL$
+
+(in-package :usocket-test)
+
+(deftest ns-host-not-found-error.1
+ (with-caught-conditions (usocket:ns-host-not-found-error nil)
+ (usocket:socket-connect "xxx" 123)
+ t)
+ nil)
+
+(deftest timeout-error.1
+ (with-caught-conditions (usocket:timeout-error nil)
+ (usocket:socket-connect "common-lisp.net" 81 :timeout 1)
+ t)
+ nil)
+
+(deftest connection-refused-error.1
+ (with-caught-conditions (usocket:connection-refused-error nil)
+ (usocket:socket-connect "common-lisp.net" 81)
+ t)
+ nil)
+
+(deftest operation-not-permitted-error.1
+ (with-caught-conditions (usocket:operation-not-permitted-error nil)
+ (usocket:socket-listen "0.0.0.0" 81)
+ t)
+ nil)
More information about the usocket-cvs
mailing list