usocket-cvs

usocket-cvs@common-lisp.net

702 discussions

[usocket-cvs] r528 - usocket/trunk/test
by Chun Tian 29 Jun '10

29 Jun '10

Author: ctian Date: Tue Jun 29 08:16:48 2010 New Revision: 528 Log: Tests: add simple unit tests for WAIT-FOR-INPUT (with other small changes). Modified: usocket/trunk/test/package.lisp usocket/trunk/test/test-usocket.lisp Modified: usocket/trunk/test/package.lisp ============================================================================== --- usocket/trunk/test/package.lisp (original) +++ usocket/trunk/test/package.lisp Tue Jun 29 08:16:48 2010 @@ -5,9 +5,7 @@ (in-package :cl-user) -(eval-when (:execute :load-toplevel :compile-toplevel) - (defpackage :usocket-test - (:use :cl :regression-test) - (:nicknames :usoct) - (:export :do-tests :run-usocket-tests))) - +(defpackage :usocket-test + (:use :cl :regression-test) + (:nicknames :usoct) + (:export :do-tests :run-usocket-tests)) Modified: usocket/trunk/test/test-usocket.lisp ============================================================================== --- usocket/trunk/test/test-usocket.lisp (original) +++ usocket/trunk/test/test-usocket.lisp Tue Jun 29 08:16:48 2010 @@ -3,19 +3,21 @@ ;;;; See LICENSE for licensing information. +;;;; Usage: (usoct:run-usocket-tests) or (usoct:do-tests) + (in-package :usocket-test) -;; The parameters below may need adjustments to match the system -;; the tests are run on. -(defparameter +non-existing-host+ "192.168.1.199") +(defparameter +non-existing-host+ "1.2.3.4") (defparameter +unused-local-port+ 15213) -(defparameter *soc1* (usocket::make-stream-socket :socket :my-socket - :stream :my-stream)) -(eval-when (:compile-toplevel :load-toplevel :execute) - (defparameter +local-ip+ #(192 168 1 25)) - (defparameter +common-lisp-net+ - #+ignore #(80 68 86 115) ;; common-lisp.net IP (not valid as of 2010-01-03 - (first (usocket::get-hosts-by-name "common-lisp.net")))) + +(defparameter *fake-usocket* + (usocket::make-stream-socket :socket :my-socket + :stream :my-stream)) + +(defconstant +common-lisp-net+ + #.(first (usocket::get-hosts-by-name "common-lisp.net"))) + +(defvar *local-ip*) (defmacro with-caught-conditions ((expect throw) &body body) `(catch 'caught-error @@ -46,19 +48,21 @@ (describe c) c)))))) -(deftest make-socket.1 (usocket:socket *soc1*) :my-socket) -(deftest make-socket.2 (usocket:socket-stream *soc1*) :my-stream) +(deftest make-socket.1 (usocket:socket *fake-usocket*) :my-socket) +(deftest make-socket.2 (usocket:socket-stream *fake-usocket*) :my-stream) (deftest socket-no-connect.1 (with-caught-conditions ('usocket:socket-error nil) (usocket:socket-connect "127.0.0.0" +unused-local-port+ :timeout 0) t) nil) + (deftest socket-no-connect.2 (with-caught-conditions ('usocket:socket-error nil) (usocket:socket-connect #(127 0 0 0) +unused-local-port+ :timeout 0) t) nil) + (deftest socket-no-connect.3 (with-caught-conditions ('usocket:socket-error nil) (usocket:socket-connect 2130706432 +unused-local-port+ :timeout 0) ;; == #(127 0 0 0) @@ -76,6 +80,7 @@ (usocket:socket-connect 2130706432 +unused-local-port+ :timeout 0) ;; == #(127 0 0 0) :unreach) nil) + (deftest socket-failure.2 (with-caught-conditions (#+(or lispworks armedbear) 'usocket:unknown-error @@ -86,11 +91,10 @@ #-(or lispworks armedbear cmu openmcl mcl) 'usocket:host-unreachable-error nil) - (usocket:socket-connect +non-existing-host+ 80 :timeout 0) ;; 80 = just a port - :unreach) + (usocket:socket-connect +non-existing-host+ 80 :timeout 0) ;; 80 = just a port + :unreach) nil) - ;; let's hope c-l.net doesn't move soon, or that people start to ;; test usocket like crazy.. (deftest socket-connect.1 @@ -100,6 +104,7 @@ (when (typep sock 'usocket:usocket) t) (usocket:socket-close sock)))) t) + (deftest socket-connect.2 (with-caught-conditions (nil nil) (let ((sock (usocket:socket-connect +common-lisp-net+ 80))) @@ -107,6 +112,7 @@ (when (typep sock 'usocket:usocket) t) (usocket:socket-close sock)))) t) + (deftest socket-connect.3 (with-caught-conditions (nil nil) (let ((sock (usocket:socket-connect (usocket::host-byte-order +common-lisp-net+) 80))) @@ -128,7 +134,7 @@ (read-line (usocket:socket-stream sock))) (usocket:socket-close sock)))) #+(or mcl clisp) "HTTP/1.1 200 OK" - #-(or clisp mcl) #.(format nil "HTTP/1.1 200 OK~A" #\Return) nil) + #-(or mcl clisp) #.(format nil "HTTP/1.1 200 OK~A" #\Return) nil) (deftest socket-name.1 (with-caught-conditions (nil nil) @@ -136,7 +142,8 @@ (unwind-protect (usocket::get-peer-address sock) (usocket:socket-close sock)))) - #.+common-lisp-net+) + +common-lisp-net+) + (deftest socket-name.2 (with-caught-conditions (nil nil) (let ((sock (usocket:socket-connect +common-lisp-net+ 80))) @@ -144,23 +151,45 @@ (usocket::get-peer-port sock) (usocket:socket-close sock)))) 80) + (deftest socket-name.3 (with-caught-conditions (nil nil) (let ((sock (usocket:socket-connect +common-lisp-net+ 80))) (unwind-protect (usocket::get-peer-name sock) (usocket:socket-close sock)))) - #.+common-lisp-net+ 80) + +common-lisp-net+) + +#+ignore (deftest socket-name.4 (with-caught-conditions (nil nil) (let ((sock (usocket:socket-connect +common-lisp-net+ 80))) (unwind-protect (usocket::get-local-address sock) (usocket:socket-close sock)))) - #.+local-ip+) + *local-ip*) + +(defparameter *wait-for-input-timeout* 2) +(deftest wait-for-input.1 + (with-caught-conditions (nil nil) + (let ((sock (usocket:socket-connect +common-lisp-net+ 80)) + (time (get-universal-time))) + (unwind-protect + (progn (usocket:wait-for-input sock :timeout *wait-for-input-timeout*) + (- (get-universal-time) time)) + (usocket:socket-close sock)))) + *wait-for-input-timeout*) + +(deftest wait-for-input.2 + (with-caught-conditions (nil nil) + (let ((sock (usocket:socket-connect +common-lisp-net+ 80)) + (time (get-universal-time))) + (unwind-protect + (progn (usocket:wait-for-input sock :timeout *wait-for-input-timeout* :ready-only t) + (- (get-universal-time) time)) + (usocket:socket-close sock)))) + *wait-for-input-timeout*) (defun run-usocket-tests () (do-tests)) - -;;; (usoct::run-usocket-tests ) \ No newline at end of file

1 0

[usocket-cvs] r527 - usocket/trunk/backend
by Chun Tian 29 Jun '10

29 Jun '10

Author: ctian Date: Tue Jun 29 08:15:32 2010 New Revision: 527 Log: LispWorks: fix typo in condition related code. Modified: usocket/trunk/backend/lispworks.lisp Modified: usocket/trunk/backend/lispworks.lisp ============================================================================== --- usocket/trunk/backend/lispworks.lisp (original) +++ usocket/trunk/backend/lispworks.lisp Tue Jun 29 08:15:32 2010 @@ -68,10 +68,10 @@ (if usock-err (if (subtypep usock-err 'error) (error usock-err :socket socket) - (signal usock-err :socket)) + (signal usock-err :socket socket)) (error 'unknown-error :socket socket - :real-condition nil)))) + :real-error nil)))) (defun raise-usock-err (errno socket &optional condition) (let* ((usock-err

1 0

[usocket-cvs] r526 - usocket/trunk
by Chun Tian 29 Jun '10

29 Jun '10

Author: ctian Date: Tue Jun 29 08:15:02 2010 New Revision: 526 Log: Condition: add default value for slot REAL-ERROR, this prevent recursive conditions when usocket conditions are reported. Modified: usocket/trunk/condition.lisp Modified: usocket/trunk/condition.lisp ============================================================================== --- usocket/trunk/condition.lisp (original) +++ usocket/trunk/condition.lisp Tue Jun 29 08:15:02 2010 @@ -118,7 +118,8 @@ (define-condition unknown-error (socket-error) ((real-error :initarg :real-error - :accessor usocket-real-error)) + :accessor usocket-real-error + :initform nil)) (:report (lambda (c stream) (typecase c (simple-condition @@ -135,8 +136,9 @@ (ns-condition)) (define-condition ns-unknown-condition (ns-condition) - ((real-error :initarg :real-condition - :accessor ns-real-condition)) + ((real-condition :initarg :real-condition + :accessor ns-real-condition + :initform nil)) (:documentation "Condition raised when there's no other - more applicable - condition available.")) @@ -151,7 +153,8 @@ (define-condition ns-unknown-error (ns-error) ((real-error :initarg :real-error - :accessor ns-real-error)) + :accessor ns-real-error + :initform nil)) (:report (lambda (c stream) (typecase c (simple-condition

1 0

[usocket-cvs] r525 - usocket/trunk/backend
by Chun Tian 28 Jun '10

28 Jun '10

Author: ctian Date: Mon Jun 28 12:09:41 2010 New Revision: 525 Log: CLISP: Clisp can't find gethostname on Linux, patch supplied by Stas Boukarev. Modified: usocket/trunk/backend/clisp.lisp Modified: usocket/trunk/backend/clisp.lisp ============================================================================== --- usocket/trunk/backend/clisp.lisp (original) +++ usocket/trunk/backend/clisp.lisp Mon Jun 28 12:09:41 2010 @@ -13,11 +13,11 @@ :OUT :ALLOCA) (len ffi:int)) #+win32 (:library "WS2_32") + #-win32 (:library :default) (:language #-win32 :stdc #+win32 :stdc-stdcall) (:return-type ffi:int)) - (defun get-host-name () (multiple-value-bind (retcode name) (get-host-name-internal 256)

1 0

[usocket-cvs] r524 - usocket/trunk
by Chun Tian 28 Jun '10

28 Jun '10

Author: ctian Date: Mon Jun 28 12:00:19 2010 New Revision: 524 Log: Additional documentation for READY-ONLY keyword argument of WAIT-FOR-INPUT. Modified: usocket/trunk/usocket.lisp Modified: usocket/trunk/usocket.lisp ============================================================================== --- usocket/trunk/usocket.lisp (original) +++ usocket/trunk/usocket.lisp Mon Jun 28 12:00:19 2010 @@ -288,7 +288,16 @@ be returned for this value either when waiting timed out or when it was interrupted (EINTR). The second value is a real number indicating the time remaining within the timeout period or NIL if -none." +none. + +Without the READY-ONLY arg, WAIT-FOR-INPUT will return all sockets in +the original list you passed it. This prevents a new list from being +consed up. Some users of USOCKET were reluctant to use it if it +wouldn't behave that way, expecting it to cost significant performance +to do the associated garbage collection. + +Without the READY-ONLY arg, you need to check the socket STATE slot for +the values documented in usocket.lisp in the usocket class." (unless (wait-list-p socket-or-sockets) (let ((wl (make-wait-list (if (listp socket-or-sockets) socket-or-sockets (list socket-or-sockets)))))

1 0

[usocket-cvs] r523 - usocket/trunk/backend
by Chun Tian 28 Jun '10

28 Jun '10

Author: ctian Date: Mon Jun 28 11:58:13 2010 New Revision: 523 Log: SBCL: Add TIMEOUT support for sb-bsd-sockets:socket-make-stream, thanks to Pavel G. Koukoushkin Modified: usocket/trunk/backend/sbcl.lisp Modified: usocket/trunk/backend/sbcl.lisp ============================================================================== --- usocket/trunk/backend/sbcl.lisp (original) +++ usocket/trunk/backend/sbcl.lisp Mon Jun 28 11:58:13 2010 @@ -210,6 +210,7 @@ (sockopt-tcp-nodelay-p (fboundp 'sb-bsd-sockets::sockopt-tcp-nodelay))) (when deadline (unsupported 'deadline 'socket-connect)) + #+ecl (when timeout (unsupported 'timeout 'socket-connect)) (when (and nodelay-specified ;; 20080802: ECL added this function to its sockets @@ -232,6 +233,8 @@ :input t :output t :buffering :full + #+sbcl #+sbcl + :timeout timeout :element-type element-type)) ;;###FIXME: The above line probably needs an :external-format (usocket (make-stream-socket :stream stream :socket socket))

1 0

[usocket-cvs] r522 - usocket/trunk/backend
by Chun Tian 02 May '10

02 May '10

Author: ctian Date: Sat May 1 21:57:55 2010 New Revision: 522 Log: Bugfix from USOCKET-UDP: call HOST-TO-HBO before detecting NULL values (Clozure only) Modified: usocket/trunk/backend/openmcl.lisp Modified: usocket/trunk/backend/openmcl.lisp ============================================================================== --- usocket/trunk/backend/openmcl.lisp (original) +++ usocket/trunk/backend/openmcl.lisp Sat May 1 21:57:55 2010 @@ -147,7 +147,7 @@ (defmethod socket-send ((usocket datagram-usocket) buffer length &key host port) (with-mapped-conditions (usocket) (openmcl-socket:send-to (socket usocket) buffer length - :remote-host (host-to-hbo host) + :remote-host (if host (host-to-hbo host)) :remote-port port))) (defmethod socket-receive ((usocket datagram-usocket) buffer length &key) @@ -204,5 +204,3 @@ (input-available-p (wait-list-waiters wait-list) (when timeout ticks-timeout)) wait-list))) - -

1 0

[usocket-cvs] r521 - usocket/trunk/backend
by Chun Tian 21 Feb '10

21 Feb '10

Author: ctian Date: Sat Feb 20 22:38:51 2010 New Revision: 521 Log: LispWorks: code clean; remove support for LispWorks 3. Modified: usocket/trunk/backend/lispworks.lisp Modified: usocket/trunk/backend/lispworks.lisp ============================================================================== --- usocket/trunk/backend/lispworks.lisp (original) +++ usocket/trunk/backend/lispworks.lisp Sat Feb 20 22:38:51 2010 @@ -6,12 +6,14 @@ (in-package :usocket) (eval-when (:compile-toplevel :load-toplevel :execute) - (require "comm")) + (require "comm") + + #+lispworks3 + (error "LispWorks 3 is not supported by USOCKET.")) ;;; --------------------------------------------------------------------------- ;;; Warn if multiprocessing is not running on Lispworks -#-win32 (defun check-for-multiprocessing-started (&optional errorp) (unless mp:*current-process* (funcall (if errorp 'error 'warn) @@ -21,11 +23,13 @@ 'mp:initialize-multiprocessing 'wait-for-input))) -#-win32 -(check-for-multiprocessing-started) +(eval-when (:load-toplevel :execute) + (check-for-multiprocessing-started)) #+win32 -(fli:register-module "ws2_32") +(eval-when (:load-toplevel :execute) + (fli:register-module "ws2_32") + (comm::ensure-sockets)) (fli:define-foreign-function (get-host-name-internal "gethostname" :source) ((return-string (:reference-return (:ef-mb-string :limit 257))) @@ -359,7 +363,8 @@ :element-type '(unsigned-byte 8) :allocation :static)) -(defvar *message-send-lock* (mp:make-lock)) +(defvar *message-send-lock* + (mp:make-lock :name "USOCKET message send lock")) (defun send-message (socket-fd buffer &optional (length (length buffer)) host service) "Send message to a socket, using sendto()/send()" @@ -368,7 +373,7 @@ (let ((message *message-send-buffer*)) (fli:with-dynamic-foreign-objects ((client-addr (:struct comm::sockaddr_in)) (len :int - #-(or lispworks3 lispworks4 lispworks5.0) + #-(or lispworks4 lispworks5.0) ; <= 5.0 :initial-element (fli:size-of '(:struct comm::sockaddr_in)))) (fli:with-dynamic-lisp-array-pointer (ptr message :type '(:unsigned :byte)) @@ -384,14 +389,15 @@ (defmethod socket-send ((socket datagram-usocket) buffer length &key host port) (let ((s (socket socket))) - (send-message s buffer length (host-to-hbo host) port))) + (send-message s buffer length (and host (host-to-hbo host)) port))) (defvar *message-receive-buffer* (make-array +max-datagram-packet-size+ :element-type '(unsigned-byte 8) :allocation :static)) -(defvar *message-receive-lock* (mp:make-lock)) +(defvar *message-receive-lock* + (mp:make-lock :name "USOCKET message receive lock")) (defun receive-message (socket-fd &optional buffer (length (length buffer)) &key read-timeout (max-buffer-size +max-datagram-packet-size+)) @@ -408,7 +414,7 @@ old-timeout) (fli:with-dynamic-foreign-objects ((client-addr (:struct comm::sockaddr_in)) (len :int - #-(or lispworks3 lispworks4 lispworks5.0) + #-(or lispworks4 lispworks5.0) ; <= 5.0 :initial-element (fli:size-of '(:struct comm::sockaddr_in)))) (fli:with-dynamic-lisp-array-pointer (ptr message :type '(:unsigned :byte)) @@ -531,7 +537,9 @@ (wait-list-waiters wait-list)))) (dolist (x (wait-list-waiters wait-list)) (mp:unnotice-fd (os-socket-handle x))) - wait-list))) + wait-list)) + +) ; end of block ;;; @@ -551,6 +559,7 @@ ;; to resort to system calls to achieve the same thing. ;; Luckily, it provides us access to the raw socket handles (as we ;; wrote the code above. + (defconstant fd-read 1) (defconstant fd-read-bit 0) (defconstant fd-write 2) @@ -603,10 +612,12 @@ :lambda-list nil :result-type :int :module "ws2_32") + (fli:define-foreign-function (wsa-event-close "WSACloseEvent" :source) ((event-object win32-handle)) :result-type :int :module "ws2_32") + (fli:define-foreign-function (wsa-enum-network-events "WSAEnumNetworkEvents" :source) ((socket ws-socket) (event-object win32-handle) @@ -670,7 +681,6 @@ (system:wait-for-single-object (wait-list-%wait wait-list) "Waiting for socket activity" timeout)) (update-ready-and-state-slots (wait-list-waiters wait-list))) - (defun map-network-events (func network-events) (let ((event-map (fli:foreign-slot-value network-events 'network-events)) @@ -691,7 +701,7 @@ (wsa-enum-network-events (os-socket-handle socket) 0 t) (if (zerop rv) (map-network-events #'(lambda (err-code) - (if (zerop err-code) + (if (zerop err-code) (setf (%ready-p socket) t (state socket) :READ) (raise-usock-err err-code socket))) @@ -707,7 +717,8 @@ (unless (null (wait-list-%wait wl)) (wsa-event-close (wait-list-%wait wl))))) - (hcl:add-special-free-action 'free-wait-list) + (eval-when (:load-toplevel :execute) + (hcl:add-special-free-action 'free-wait-list)) (defun %setup-wait-list (wait-list) (hcl:flag-special-free-action wait-list) @@ -716,7 +727,8 @@ (defun %add-waiter (wait-list waiter) (let ((events (etypecase waiter (stream-server-usocket (logior fd-connect fd-accept fd-close)) - (stream-usocket (logior fd-connect fd-read fd-oob fd-close))))) + (stream-usocket (logior fd-connect fd-read fd-oob fd-close)) + (datagram-usocket (logior fd-read))))) (maybe-wsa-error (wsa-event-select (os-socket-handle waiter) (wait-list-%wait wait-list) events) waiter))) @@ -726,4 +738,4 @@ (wsa-event-select (os-socket-handle waiter) (wait-list-%wait wait-list) 0) waiter)) - );; end of WIN32-block +) ; end of WIN32-block

1 0

[usocket-cvs] r520 - usocket/trunk/backend
by Chun Tian 13 Jan '10

13 Jan '10

Author: ctian Date: Wed Jan 13 04:51:07 2010 New Revision: 520 Log: Patch from R. Matthew Emerson: report nameserver errors in the socket-creation-error condition object. Modified: usocket/trunk/backend/openmcl.lisp Modified: usocket/trunk/backend/openmcl.lisp ============================================================================== --- usocket/trunk/backend/openmcl.lisp (original) +++ usocket/trunk/backend/openmcl.lisp Wed Jan 13 04:51:07 2010 @@ -25,6 +25,10 @@ (:shutdown . shutdown-error) (:access-denied . operation-not-permitted-error))) +(defparameter +openmcl-nameserver-error-map+ + '((:no-recovery . ns-no-recovery-error) + (:try-again . ns-try-again-condition) + (:host-not-found . ns-host-not-found-error))) ;; we need something which the openmcl implementors 'forgot' to do: ;; wait for more than one socket-or-fd @@ -66,8 +70,12 @@ (ccl:communication-deadline-expired (error 'deadline-timeout-error :socket socket)) (ccl::socket-creation-error #| ugh! |# - (raise-error-from-id (ccl::socket-creation-error-identifier condition) - socket condition)))) + (let* ((condition-id (ccl::socket-creation-error-identifier condition)) + (nameserver-error (cdr (assoc condition-id + +openmcl-nameserver-error-map+)))) + (if nameserver-error + (error nameserver-error :host-or-ip nil) + (raise-error-from-id condition-id socket condition)))))) (defun to-format (element-type) (if (subtypep element-type 'character)

1 0

[usocket-cvs] r519 - usocket/trunk
by Chun Tian 13 Jan '10

13 Jan '10

Author: ctian Date: Wed Jan 13 04:48:05 2010 New Revision: 519 Log: ASDF dependency fixes Modified: usocket/trunk/usocket.asd Modified: usocket/trunk/usocket.asd ============================================================================== --- usocket/trunk/usocket.asd (original) +++ usocket/trunk/usocket.asd Wed Jan 13 04:48:05 2010 @@ -19,12 +19,12 @@ :description "Universal socket library for Common Lisp" :depends-on (#+sbcl :sb-bsd-sockets) :components ((:file "package") - (:module "vendor" + (:module "vendor" :depends-on ("package") :components ((:file "split-sequence") #+mcl (:file "kqueue"))) - (:file "usocket" :depends-on ("package" "vendor")) + (:file "usocket" :depends-on ("vendor")) (:file "condition" :depends-on ("usocket")) - (:module "backend" :depends-on ("usocket" "condition") + (:module "backend" :depends-on ("condition") :components (#+clisp (:file "clisp") #+cmu (:file "cmucl") #+scl (:file "scl")

1 0

← Newer
1
...
15
16
17
18
19
20
21
...
71
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

usocket-cvs