Author: ctian Date: Wed Mar 30 04:12:45 2011 New Revision: 613
Log: Basic SOCKET-OPTION framework added.
Added: usocket/trunk/option.lisp (contents, props changed) Modified: usocket/trunk/package.lisp usocket/trunk/usocket-test.asd usocket/trunk/usocket.asd
Added: usocket/trunk/option.lisp ============================================================================== --- (empty file) +++ usocket/trunk/option.lisp Wed Mar 30 04:12:45 2011 @@ -0,0 +1,93 @@ +;;;; $Id$ +;;;; $URL$ + +;;;; SOCKET-OPTION, a high-level socket option get/set facility +;;;; Author: Chun Tian (binghe) + +;;;; See LICENSE for licensing information. + +(in-package :usocket) + +;;; Interface definition + +(defgeneric socket-option (socket option &key) + (:documentation + "Get a socket's internal options")) + +(defgeneric (setf socket-option) (new-value socket option &key) + (:documentation + "Set a socket's internal options")) + +;;; Handling of wrong type of arguments + +(defmethod socket-option ((socket usocket) (option t) &key) + (error 'type-error :datum option :expected-type 'keyword)) + +(defmethod (setf socket-option) (new-value (socket usocket) (option t) &key) + (declare (ignore new-value)) + (socket-option socket option)) + +(defmethod socket-option ((socket usocket) (option symbol) &key) + (if (keywordp option) + (error 'unimplemented :feature option :context 'socket-option) + (error 'type-error :datum option :expected-type 'keyword))) + +(defmethod (setf socket-option) (new-value (socket usocket) (option symbol) &key) + (declare (ignore new-value)) + (socket-option socket option)) + +;;; Option: RECEIVE-TIMEOUT (RCVTIMEO) +;;; Scope: TCP & UDP + +(defmethod socket-option ((usocket stream-usocket) + (option (eql :receive-timeout)) &key) + (let ((socket (socket usocket))) + #+abcl + () ; TODO + #+allegro + () ; TODO + #+clisp + (socket:socket-options socket :so-rcvtimeo) + #+clozure + (ccl:stream-input-timeout socket) + #+cmu + (lisp::fd-stream-timeout (socket-stream usocket)) + #+ecl + (sb-bsd-sockets:sockopt-receive-timeout socket) + #+lispworks + (get-socket-receive-timeout socket) + #+mcl + () ; TODO + #+sbcl + (sb-impl::fd-stream-timeout (socket-stream usocket)) + #+scl + ())) + +(defmethod (setf socket-option) (new-value (usocket stream-usocket) + (option (eql :receive-timeout)) &key) + (declare (type number new-value)) + (let ((socket (socket usocket)) + (timeout new-value)) + #+abcl + () ; TODO + #+allegro + () ; TODO + #+clisp + (socket:socket-options socket :so-rcvtimeo timeout) + #+clozure + (setf (ccl:stream-input-timeout socket) timeout) + #+cmu + (setf (lisp::fd-stream-timeout (socket-stream usocket)) + (coerce timeout 'integer)) + #+ecl + (setf (sb-bsd-sockets:sockopt-receive-timeout socket) timeout) + #+lispworks + (set-socket-receive-timeout socket timeout) + #+mcl + () ; TODO + #+sbcl + (setf (sb-impl::fd-stream-timeout (socket-stream usocket)) + (coerce timeout 'single-float)) + #+scl + () + new-value))
Modified: usocket/trunk/package.lisp ============================================================================== --- usocket/trunk/package.lisp (original) +++ usocket/trunk/package.lisp Wed Mar 30 04:12:45 2011 @@ -29,6 +29,7 @@ #:socket-send ; udp function (send) #:socket-receive ; udp function (receive) #:socket-server ; udp server + #:socket-option ; 0.6.x
#:wait-for-input ; waiting for input-ready state (select() like) #:make-wait-list
Modified: usocket/trunk/usocket-test.asd ============================================================================== --- usocket/trunk/usocket-test.asd (original) +++ usocket/trunk/usocket-test.asd Wed Mar 30 04:12:45 2011 @@ -15,6 +15,7 @@ (defsystem usocket-test :name "usocket test" :author "Erik Enge" + :maintainer "Chun Tian (binghe)" :version "0.1.0" :licence "MIT" :description "Tests for usocket"
Modified: usocket/trunk/usocket.asd ============================================================================== --- usocket/trunk/usocket.asd (original) +++ usocket/trunk/usocket.asd Wed Mar 30 04:12:45 2011 @@ -14,6 +14,7 @@ (defsystem usocket :name "usocket" :author "Erik Enge & Erik Huelsmann" + :maintainer "Chun Tian (binghe)" :version "0.6.0" :licence "MIT" :description "Universal socket library for Common Lisp" @@ -36,7 +37,8 @@ #+mcl (:file "mcl") #+openmcl (:file "openmcl") #+allegro (:file "allegro"))) - (:file "server" :depends-on ("backend")))) + (:file "option" :depends-on ("backend")) + (:file "server" :depends-on ("backend" "option"))))
(defmethod perform ((op test-op) (c (eql (find-system :usocket)))) (oos 'load-op :usocket-test)