- usocket-cvs@common-lisp.net - mailman3.common-lisp.net

[usocket-cvs] r325 - usocket/trunk
by ehuelsmann＠common-lisp.net 11 Apr '08

11 Apr '08

Author: ehuelsmann Date: Fri Apr 11 17:12:29 2008 New Revision: 325 Modified: usocket/trunk/condition.lisp Log: Correct condition name; by Hans Huebner (hans at huebner dot org). Modified: usocket/trunk/condition.lisp ============================================================================== --- usocket/trunk/condition.lisp (original) +++ usocket/trunk/condition.lisp Fri Apr 11 17:12:29 2008 @@ -148,7 +148,7 @@ ((50 100) . network-down-error) ((52 102) . network-reset-error) ((58 108) . already-shutdown-error) - ((60 110) . connection-timeout-error) + ((60 110) . timeout-error) ((64 112) . host-down-error) ((65 113) . host-unreachable-error)))

1 0

[usocket-cvs] r324 - in usocket/trunk: . backend
by ehuelsmann＠common-lisp.net 11 Apr '08

11 Apr '08

Author: ehuelsmann Date: Fri Apr 11 17:08:02 2008 New Revision: 324 Modified: usocket/trunk/backend/clisp.lisp usocket/trunk/usocket.lisp Log: Small doc change and spacing fix. Modified: usocket/trunk/backend/clisp.lisp ============================================================================== --- usocket/trunk/backend/clisp.lisp (original) +++ usocket/trunk/backend/clisp.lisp Fri Apr 11 17:08:02 2008 @@ -217,7 +217,7 @@ (defmethod socket-close ((usocket datagram-usocket)) (rawsock:sock-close (socket usocket))) - + ) #-rawsock Modified: usocket/trunk/usocket.lisp ============================================================================== --- usocket/trunk/usocket.lisp (original) +++ usocket/trunk/usocket.lisp Fri Apr 11 17:08:02 2008 @@ -77,6 +77,7 @@ (defclass datagram-usocket (usocket) ((connected-p :initarg :connected-p :accessor connected-p)) +;; ###FIXME: documentation to be added. (:documentation "")) (defun make-socket (&key socket)

1 0

[usocket-cvs] r323 - in usocket/trunk: . backend
by ehuelsmann＠common-lisp.net 19 Mar '08

19 Mar '08

Author: ehuelsmann Date: Wed Mar 19 17:47:05 2008 New Revision: 323 Modified: usocket/trunk/backend/clisp.lisp usocket/trunk/usocket.lisp Log: Datagram (udp) socket creation interface. [Use socket-close to close the socket. Modified: usocket/trunk/backend/clisp.lisp ============================================================================== --- usocket/trunk/backend/clisp.lisp (original) +++ usocket/trunk/backend/clisp.lisp Wed Mar 19 17:47:05 2008 @@ -162,6 +162,22 @@ (ip-to-octet-buffer sockaddr_in ip :start 2) sockaddr_in) + (defun socket-create-datagram (local-port + &key (local-host *wildcard-host*) + remote-host + remote-port) + (let ((sock (rawsock:socket :inet :dgram 0)) + (lsock_addr (fill-sockaddr_in (make-sockaddr_in) + local-host local-port)) + (rsock_addr (when remote-host + (fill-sockaddr_in (make-sockaddr_in) + remote-host (or remote-port + local-port))))) + (bind sock lsock_addr) + (when rsock_addr + (connect sock rsock_addr)) + (make-datagram-socket sock :connected-p (if rsock_addr t nil)))) + (defun socket-receive (socket buffer &key (size (length buffer))) "Returns the buffer, the number of octets copied into the buffer (received) and the address of the sender as values." Modified: usocket/trunk/usocket.lisp ============================================================================== --- usocket/trunk/usocket.lisp (original) +++ usocket/trunk/usocket.lisp Wed Mar 19 17:47:05 2008 @@ -114,6 +114,13 @@ :socket socket :element-type element-type)) +(defun make-datagram-socket (socket &key connected-p) + (unless socket + (error 'invalid-socket-error)) + (make-instance 'datagram-usocket + :socket socket + :connected-p connected-p)) + (defgeneric socket-accept (socket &key element-type) (:documentation "Accepts a connection from `socket', returning a `stream-socket'.

1 0

[usocket-cvs] r322 - usocket/trunk/backend
by ehuelsmann＠common-lisp.net 05 Mar '08

05 Mar '08

Author: ehuelsmann Date: Wed Mar 5 17:13:31 2008 New Revision: 322 Modified: usocket/trunk/backend/clisp.lisp Log: Correct spelling of socket closing routine SOCKET-CLOSE -> SOCK-CLOSE. Modified: usocket/trunk/backend/clisp.lisp ============================================================================== --- usocket/trunk/backend/clisp.lisp (original) +++ usocket/trunk/backend/clisp.lisp Wed Mar 5 17:13:31 2008 @@ -200,7 +200,7 @@ rv)) (defmethod socket-close ((usocket datagram-usocket)) - (rawsock:socket-close (socket usocket))) + (rawsock:sock-close (socket usocket))) )

1 0

[usocket-cvs] r321 - usocket/trunk/backend
by ehuelsmann＠common-lisp.net 28 Feb '08

28 Feb '08

Author: ehuelsmann Date: Thu Feb 28 02:30:01 2008 New Revision: 321 Modified: usocket/trunk/backend/clisp.lisp Log: Preliminary implementation of datagram sockets send(to)/recv(from) functions. TODO: - Adjust WAIT-FOR-INPUT - Think of a name to instantiate datagram sockets - Make sure the functions which retrieve local and remote socket names work with datagram sockets Modified: usocket/trunk/backend/clisp.lisp ============================================================================== --- usocket/trunk/backend/clisp.lisp (original) +++ usocket/trunk/backend/clisp.lisp Thu Feb 28 02:30:01 2008 @@ -145,3 +145,69 @@ (when y x)) sockets status-list)))))) + +;; +;; UDP/Datagram sockets! +;; + +#+rawsock +(progn + + (defun make-sockaddr_in () + (make-array 16 :element-type '(unsigned-byte 8) :initial-element 0)) + + (declaim (inline fill-sockaddr_in)) + (defun fill-sockaddr_in (sockaddr_in ip port) + (port-to-octet-buffer sockaddr_in port) + (ip-to-octet-buffer sockaddr_in ip :start 2) + sockaddr_in) + + (defun socket-receive (socket buffer &key (size (length buffer))) + "Returns the buffer, the number of octets copied into the buffer (received) +and the address of the sender as values." + (let* ((sock (socket socket)) + (sockaddr (when (not (connected-p socket)) + (rawsock:make-sockaddr))) + (rv (if sockaddr + (rawsock:recvfrom sock buffer sockaddr + :start 0 + :end size) + (rawsock:recv sock buffer + :start 0 + :end size)))) + (values buffer + rv + (list (ip-from-octet-buffer (sockaddr-data sockaddr) 4) + (port-from-octet-buffer (sockaddr-data sockaddr) 2))))) + + (defun socket-send (socket buffer &key address (size (length buffer))) + "Returns the number of octets sent." + (let* ((sock (socket socket)) + (sockaddr (when address + (rawsock:make-sockaddr :INET + (fill-sockaddr_in + (make-sockaddr_in) + (host-byte-order + (second address)) + (first address))))) + (rv (if address + (rawsock:sendto sock buffer sockaddr + :start 0 + :end size) + (rawsock:send sock buffer + :start 0 + :end size)))) + rv)) + + (defmethod socket-close ((usocket datagram-usocket)) + (rawsock:socket-close (socket usocket))) + + ) + +#-rawsock +(progn + (warn "This image doesn't contain the RAWSOCK package. +To enable UDP socket support, please be sure to use the -Kfull parameter +at startup, or to enable RAWSOCK support during compilation.") + + ) \ No newline at end of file

1 0

[usocket-cvs] r320 - usocket/trunk
by ehuelsmann＠common-lisp.net 21 Feb '08

21 Feb '08

Author: ehuelsmann Date: Thu Feb 21 15:29:19 2008 New Revision: 320 Modified: usocket/trunk/usocket.asd Log: Update version identifier, as 0.4.x has branched now, we're working toward 0.5.0. Modified: usocket/trunk/usocket.asd ============================================================================== --- usocket/trunk/usocket.asd (original) +++ usocket/trunk/usocket.asd Thu Feb 21 15:29:19 2008 @@ -14,7 +14,7 @@ (defsystem usocket :name "usocket" :author "Erik Enge & Erik Huelsmann" - :version "0.4.0-dev" + :version "0.5.0-dev" :licence "MIT" :description "Universal socket library for Common Lisp" :depends-on (:split-sequence

1 0

[usocket-cvs] r319 - usocket/trunk
by ehuelsmann＠common-lisp.net 20 Feb '08

20 Feb '08

Author: ehuelsmann Date: Wed Feb 20 16:47:46 2008 New Revision: 319 Modified: usocket/trunk/package.lisp usocket/trunk/usocket.lisp Log: Introduce datagram socket and several utility functions. Modified: usocket/trunk/package.lisp ============================================================================== --- usocket/trunk/package.lisp (original) +++ usocket/trunk/package.lisp Wed Feb 20 16:47:46 2008 @@ -33,6 +33,7 @@ #:stream-server-usocket #:socket #:socket-stream + #:datagram-usocket #:host-byte-order ; IP(v4) utility functions #:hbo-to-dotted-quad @@ -42,6 +43,13 @@ #:ip= #:ip/= + #:integer-to-octet-buffer ; Network utility functions + #:octet-buffer-to-integer + #:port-to-octet-buffer + #:port-from-octet-buffer + #:ip-to-octet-buffer + #:ip-from-octet-buffer + #:socket-condition ; conditions #:ns-condition #:socket-error ; errors Modified: usocket/trunk/usocket.lisp ============================================================================== --- usocket/trunk/usocket.lisp (original) +++ usocket/trunk/usocket.lisp Wed Feb 20 16:47:46 2008 @@ -73,13 +73,11 @@ (typep socket 'stream-server-usocket)) (defun datagram-usocket-p (socket) - (declare (ignore socket)) - nil) + (typep socket 'datagram-usocket)) -;;Not in use yet: -;;(defclass datagram-usocket (usocket) -;; () -;; (:documentation "")) +(defclass datagram-usocket (usocket) + ((connected-p :initarg :connected-p :accessor connected-p)) + (:documentation "")) (defun make-socket (&key socket) "Create a usocket socket type from implementation specific socket." @@ -235,6 +233,42 @@ (when (< elapsed timeout) (- timeout elapsed))))))) + +;; +;; Data utility functions +;; + +(defun integer-to-octet-buffer (integer buffer octets &key (start 0)) + (do ((b start (1+ b)) + (i (ash (1- octets) 3) ;; * 8 + (- i 8))) + ((> 0 i) buffer) + (setf (aref buffer b) + (ldb (byte 8 i) integer)))) + +(defun octet-buffer-to-integer (buffer octets &key (start 0)) + (let ((integer 0)) + (do ((b start (1+ b)) + (i (ash (1- octets) 3) ;; * 8 + (- i 8))) + ((> 0 i) + integer) + (setf (ldb (byte 8 i) integer) + (aref buffer b))))) + + +(defmacro port-to-octet-buffer (port buffer &key (start 0)) + `(integer-to-octet-buffer ,port ,buffer 2 ,start)) + +(defmacro ip-to-octet-buffer (ip buffer &key (start 0)) + `(integer-to-octet-buffer (host-byte-order ,ip) ,buffer 4 ,start)) + +(defmacro port-from-octet-buffer (buffer &key (start 0)) + `(octet-buffer-to-integer ,buffer 2 ,start)) + +(defmacro ip-from-octet-buffer (buffer &key (start 0)) + `(octet-buffer-to-integer ,buffer 4 ,start)) + ;; ;; IP(v4) utility functions ;;

1 0

[usocket-cvs] r318 - usocket/branches/0.4.x
by ehuelsmann＠common-lisp.net 20 Feb '08

20 Feb '08

Author: ehuelsmann Date: Wed Feb 20 16:38:47 2008 New Revision: 318 Added: usocket/branches/0.4.x/ - copied from r317, usocket/trunk/ Log: Make way on trunk for development of UDP sockets interfaces by creating a WAIT-FOR-INPUT branch (0.4.x).

1 0

[usocket-cvs] r317 - usocket/trunk/backend
by ehuelsmann＠common-lisp.net 17 Feb '08

17 Feb '08

Author: ehuelsmann Date: Sun Feb 17 16:40:31 2008 New Revision: 317 Modified: usocket/trunk/backend/sbcl.lisp Log: Fix nameservice condition/error names; also revert some of r307: fast-unix-select *does* return errno, but change the code a bit to prevent the compiler from issueing warnings. Modified: usocket/trunk/backend/sbcl.lisp ============================================================================== --- usocket/trunk/backend/sbcl.lisp (original) +++ usocket/trunk/backend/sbcl.lisp Sun Feb 17 16:40:31 2008 @@ -162,8 +162,8 @@ ;; Nameservice errors: mapped to unknown-error (sb-bsd-sockets:no-recovery-error . ns-no-recovery-error) - (sb-bsd-sockets:try-again-condition . ns-try-again-condition) - (sb-bsd-sockets:host-not-found . ns-host-not-found-error))) + (sb-bsd-sockets:try-again-error . ns-try-again-condition) + (sb-bsd-sockets:host-not-found-error . ns-host-not-found-error))) (defun handle-condition (condition &optional (socket nil)) "Dispatch correct usocket condition." @@ -279,25 +279,24 @@ (multiple-value-bind (secs musecs) (split-timeout (or timeout 1)) - (let ((count - (sb-unix:unix-fast-select - (1+ (reduce #'max (mapcar #'socket sockets) - :key #'sb-bsd-sockets:socket-file-descriptor)) - (sb-alien:addr rfds) nil nil - (when timeout secs) musecs))) - (unless (= 0 count) ;; 0 means timeout - (if (=> count 0) + (multiple-value-bind + (count err) + (sb-unix:unix-fast-select + (1+ (reduce #'max (mapcar #'socket sockets) + :key #'sb-bsd-sockets:socket-file-descriptor)) + (sb-alien:addr rfds) nil nil + (when timeout secs) musecs) + (if (null count) + (unless (= err sb-unix:EINTR) + (error (map-errno-error err))) + (when (< 0 count) ;; process the result... (remove-if #'(lambda (x) - (not - (sb-unix:fd-isset - (sb-bsd-sockets:socket-file-descriptor (socket x)) - rfds))) - sockets) - (let ((err (sb-alien:get-errno))) - (unless (= err sb-unix:EINTR) - (error (map-errno-error err))))))))))) + (not (sb-unix:fd-isset + (sb-bsd-sockets:socket-file-descriptor (socket x)) + rfds))) + sockets)))))))) #+win32 (warn "wait-for-input not (yet!) supported...")

1 0

[usocket-cvs] r316 - in usocket/trunk: . backend
by ehuelsmann＠common-lisp.net 17 Feb '08

17 Feb '08

Author: ehuelsmann Date: Sun Feb 17 14:29:16 2008 New Revision: 316 Modified: usocket/trunk/backend/lispworks.lisp usocket/trunk/usocket.lisp Log: Take alternate approach on LW: We don't know whether the internals depend on WSAEnumNetworkEvents(), but if we use that function, the internals can't work correctly anymore: it clears the socket state. So, for the stream socket (the one type supported by LispWorks), resort to trickery to establish whether there are octets to be read from the network buffer. Modified: usocket/trunk/backend/lispworks.lisp ============================================================================== --- usocket/trunk/backend/lispworks.lisp (original) +++ usocket/trunk/backend/lispworks.lisp Sun Feb 17 14:29:16 2008 @@ -45,11 +45,13 @@ (defun raise-or-signal-socket-error (errno socket) (let ((usock-err (cdr (assoc errno +lispworks-error-map+ :test #'member)))) - (when usock-err ;; don't claim the error when we're not sure - ;; it's actually sockets related + (if usock-err (if (subtypep usock-err 'error) (error usock-err :socket socket) - (signal usock-err :socket))))) + (signal usock-err :socket)) + (error 'unknown-error + :socket socket + :real-condition nil)))) (defun raise-usock-err (errno socket &optional condition) (let* ((usock-err @@ -105,6 +107,9 @@ :direction :io :element-type (or element-type (element-type usocket))))) + #+win32 + (when sock + (setf (%ready-p usocket) nil)) (make-stream-socket :socket sock :stream stream))) ;; Sockets and their streams are different objects @@ -148,9 +153,7 @@ (comm:get-host-entry name :fields '(:addresses))))) (defun os-socket-handle (usocket) - (if (stream-usocket-p usocket) - (comm:socket-stream-socket (socket usocket)) - (socket usocket))) + (socket usocket)) (defun usocket-listen (usocket) (if (stream-usocket-p usocket) @@ -223,6 +226,8 @@ (defconstant fd-max-events 10) + (defconstant fionread 1074030207) + (fli:define-foreign-type ws-socket () '(:unsigned :int)) (fli:define-foreign-type win32-handle () '(:unsigned :int)) (fli:define-c-struct wsa-network-events (network-events :long) @@ -234,7 +239,7 @@ :result-type :int :module "ws2_32") (fli:define-foreign-function (wsa-event-close "WSACloseEvent" :source) - (event-object win32-handle) + ((event-object win32-handle)) :result-type :int :module "ws2_32") (fli:define-foreign-function (wsa-enum-network-events "WSAEnumNetworkEvents" :source) @@ -256,6 +261,15 @@ :result-type :int :module "ws2_32") + (fli:define-foreign-function (wsa-ioctlsocket "ioctlsocket" :source) + ((socket :long) (cmd :long) (argp (:ptr :long))) + :result-type :int + :module "ws2_32") + + + ;; The Windows system + + ;; Now that we have access to the system calls, this is the plan: ;; 1. Receive a list of sockets to listen to @@ -271,6 +285,13 @@ (unless (zerop rv) (raise-usock-err (wsa-get-last-error) socket))) + (defun bytes-available-for-read (socket) + (fli:with-dynamic-foreign-objects ((int-ptr :long)) + (let ((rv (wsa-ioctlsocket (os-socket-handle socket) fionread int-ptr))) + (if (= 0 rv) + (fli:dereference int-ptr) + 0)))) + (defun add-socket-to-event (socket event-object) (let ((events (etypecase socket (stream-server-usocket (logior fd-connect fd-accept fd-close)) @@ -279,52 +300,51 @@ (wsa-event-select (os-socket-handle socket) event-object events) socket))) - (defun wait-for-sockets (sockets timeout) + (defun socket-ready-p (socket) + (if (typep socket 'stream-usocket) + (< 0 (bytes-available-for-read socket)) + (%ready-p socket))) + + (defun waiting-required (sockets) + (notany #'socket-ready-p sockets)) + + (defun wait-for-input-internal (sockets &key timeout) (let ((event-object (wsa-event-create))) (unwind-protect (progn - (dolist (socket sockets) - (add-socket-to-event socket event-object)) - (system:wait-for-single-object event-object - "Waiting for socket activity" timeout)) - (maybe-wsa-error - (wsa-event-close event-object) - nil)))) - + (when (waiting-required sockets) + (dolist (socket sockets) + (add-socket-to-event socket event-object)) + (system:wait-for-single-object event-object + "Waiting for socket activity" timeout)) + (update-ready-slots sockets) + (sockets-ready sockets)) + (wsa-event-close event-object)))) (defun map-network-events (func network-events) (let ((event-map (fli:foreign-slot-value network-events 'network-events)) - (error-array (fli:foreign-slot-value network-events 'error-code))) + (error-array (fli:foreign-slot-pointer network-events 'error-code))) (unless (zerop event-map) - (dotimes (i fd-max-events) - (unless (zerop (ldb (byte 1 i) event-map)) - (funcall func (fli:foreign-aref error-array i))))))) + (dotimes (i fd-max-events) + (unless (zerop (ldb (byte 1 i) event-map)) + (funcall func (fli:foreign-aref error-array i))))))) + + (defun update-ready-slots (sockets) + (dolist (socket sockets) + (unless (or (stream-usocket-p socket) ;; no need to check status for streams + (%ready-p socket)) ;; and sockets already marked ready + (multiple-value-bind + (rv network-events) + (wsa-enum-network-events (os-socket-handle socket) 0 t) + (if (zerop rv) + (map-network-events #'(lambda (err-code) + (if (zerop err-code) + (setf (%ready-p socket) t) + (raise-usock-err err-code socket))) + network-events) + (maybe-wsa-error rv socket)))))) (defun sockets-ready (sockets) - (remove-if-not - #'(lambda (socket) - (multiple-value-bind - (rv network-events) - (wsa-enum-network-events (os-socket-handle socket) 0) - (if (zerop rv) - (let ((non-error-state-p nil)) - ;; raise any errors we find - (map-network-events - #'(lambda (err-code) - (if (zerop err-code) - (setf non-error-statep t) - (let ((err-class (map-errno-error err-code))) - (if (subtypep err-class 'socket-error) - (error err-class :socket socket) - (error err-class))))) - network-events) - ;; return whether we found non-error state - non-error-state-p) - (maybe-wsa-error rv socket)))) - sockets)) - - (defun wait-for-input-internal (sockets &key timeout) - (wait-for-sockets sockets timeout) - (sockets-ready sockets)) - + (remove-if-not #'socket-ready-p sockets)) + );; end of WIN32-block Modified: usocket/trunk/usocket.lisp ============================================================================== --- usocket/trunk/usocket.lisp (original) +++ usocket/trunk/usocket.lisp Sun Feb 17 14:29:16 2008 @@ -45,7 +45,21 @@ #+lispworks 'base-char :reader element-type :documentation "Default element type for streams created by -`socket-accept'.")) +`socket-accept'.") + #+(and lispworks win32) + (%ready-p + :initform nil + :accessor %ready-p + :documentation "Indicates whether the socket has been signalled +as ready for reading a new connection. + +The value will be set to T by `wait-for-input-internal' (given the +right conditions) and reset to NIL by `socket-accept'. + +Don't modify this slot or depend on it as it is really intended +to be internal only. +" + )) (:documentation "Socket which listens for stream connections to be initiated from remote sockets."))

1 0