Changeset 14881


Ignore:
Timestamp:
09/30/16 09:18:00 (14 months ago)
Author:
mevenson
Message:

USOCKET monkey patch: use an actual patch

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/patches/usocket-backend-abcl.patch

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