[usocket-cvs] r613 - usocket/trunk

[Chun Tian (binghe)]

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)