Re: net.lisp basic sbcl sb-bsd-sockets support

--=-=-=

Sam Steingold writes:

>> * Philippe Brochard <[email protected]> [2006-06-21 22:53:30 +0200]:
>>
>> I answer to myself, here is a new patch to have the wait option in
>> socket-accept.
>
> please send a unified context diff.
>
>> And socket-accept return two values: the stream and the real
>> socket. So socket-host/port works with this second value.
>
> this is a change in the API.  not a good idea.
> is sbcl socket is just the fd, one can use getsockname et al.
>
yes, this is uggly and a very bad idea (sorry, it's rubbish).

sbcl socket is just a fd and how to call getsockname is hidden deeply
in the sbcl source code :)
But here is a version without API change.


Regards,


Philippe

-- 
Philippe Brochard    <[email protected]>
                      http://hocwp.free.fr

-=-= http://www.gnu.org/home.fr.html =-=-

--=-=-=
Content-Disposition: inline; filename=net.lisp.diff

Index: net.lisp
===================================================================
RCS file: /cvsroot/clocc/clocc/src/port/net.lisp,v
retrieving revision 1.59
diff -c -r1.59 net.lisp
*** net.lisp	25 Dec 2005 23:53:47 -0000	1.59
--- net.lisp	22 Jun 2006 19:00:45 -0000
***************
*** 14,23 ****
  (eval-when (compile load eval)
    (require :port-ext (translate-logical-pathname "clocc:src;port;ext"))
    ;; `getenv'
!   (require :port-sys (translate-logical-pathname "port:sys"))
    #+(or cmu scl) (require :simple-streams) ; for `set-socket-stream-format'
    #+cormanlisp (require :winsock)
!   #+lispworks (require "comm"))
  
  (in-package :port)
  
--- 14,27 ----
  (eval-when (compile load eval)
    (require :port-ext (translate-logical-pathname "clocc:src;port;ext"))
    ;; `getenv'
!   require :port-sys (translate-logical-pathname "port:sys"))
    #+(or cmu scl) (require :simple-streams) ; for `set-socket-stream-format'
    #+cormanlisp (require :winsock)
!   #+lispworks (require "comm")
!   #+(and sbcl (not (or db-sockets net.sbcl.sockets)))
!   (progn
!     (require :sb-bsd-sockets)
!     (pushnew :sb-bsd-sockets *features*)))
  
  (in-package :port)
  
***************
*** 60,79 ****
      (+ (ash (first ll) 24) (ash (second ll) 16)
         (ash (third ll) 8) (fourth ll))))
  
! ;#+(and sbcl db-sockets)
  ;(declaim (ftype (function (vector) (values (unsigned-byte 32)))
  ;                vector-to-ipaddr))
! #+(and sbcl db-sockets)
  (defun vector-to-ipaddr (vector)
    (+ (ash (aref vector 0) 24)
       (ash (aref vector 1) 16)
       (ash (aref vector 2) 8)
       (aref vector 3)))
  
! ;#+(and sbcl db-sockets)
  ;(declaim (ftype (function (vector) (values (unsigned-byte 32)))
  ;                ipaddr-to-vector))
! #+(and sbcl db-sockets)
  (defun ipaddr-to-vector (ipaddr)
    (vector (ldb (byte 8 24) ipaddr)
            (ldb (byte 8 16) ipaddr)
--- 64,83 ----
      (+ (ash (first ll) 24) (ash (second ll) 16)
         (ash (third ll) 8) (fourth ll))))
  
! ;#+(and sbcl (or db-sockets sb-bsd-sockets))
  ;(declaim (ftype (function (vector) (values (unsigned-byte 32)))
  ;                vector-to-ipaddr))
! #+(and sbcl (or db-sockets sb-bsd-sockets))
  (defun vector-to-ipaddr (vector)
    (+ (ash (aref vector 0) 24)
       (ash (aref vector 1) 16)
       (ash (aref vector 2) 8)
       (aref vector 3)))
  
! ;#+(and sbcl (or db-sockets sb-bsd-sockets))
  ;(declaim (ftype (function (vector) (values (unsigned-byte 32)))
  ;                ipaddr-to-vector))
! #+(and sbcl (or db-sockets sb-bsd-sockets))
  (defun ipaddr-to-vector (ipaddr)
    (vector (ldb (byte 8 24) ipaddr)
            (ldb (byte 8 16) ipaddr)
***************
*** 179,186 ****
    #+openmcl 'ccl::socket
    #+(and sbcl db-sockets) 'sb-sys:fd-stream
    #+(and sbcl net.sbcl.sockets) 'net.sbcl.sockets:stream-socket
    #-(or abcl allegro clisp cmu gcl lispworks openmcl
! 	(and sbcl (or db-sockets net.sbcl.sockets)) scl) 'stream)
  
  (defun open-socket (host port &optional bin)
    "Open a socket connection to HOST at PORT."
--- 183,191 ----
    #+openmcl 'ccl::socket
    #+(and sbcl db-sockets) 'sb-sys:fd-stream
    #+(and sbcl net.sbcl.sockets) 'net.sbcl.sockets:stream-socket
+   #+(and sbcl sb-bsd-sockets) 'sb-sys:fd-stream
    #-(or abcl allegro clisp cmu gcl lispworks openmcl
! 	(and sbcl (or db-sockets net.sbcl.sockets sb-bsd-sockets)) scl) 'stream)
  
  (defun open-socket (host port &optional bin)
    "Open a socket connection to HOST at PORT."
***************
*** 221,228 ****
           'net.sbcl.sockets:binary-stream-socket
           'net.sbcl.sockets:character-stream-socket)
       :port port :host host)
      #-(or abcl allegro clisp cmu gcl lispworks mcl
!           (and sbcl (or net.sbcl.sockets db-sockets)) scl)
      (error 'not-implemented :proc (list 'open-socket host port bin))))
  
  (defun set-socket-stream-format (socket format)
--- 226,243 ----
           'net.sbcl.sockets:binary-stream-socket
           'net.sbcl.sockets:character-stream-socket)
       :port port :host host)
+     #+(and sbcl sb-bsd-sockets)
+     (let ((socket (make-instance 'sb-bsd-sockets:inet-socket
+                                  :type :stream :protocol :tcp)))
+       (sb-bsd-sockets:socket-connect socket
+ 				     (sb-bsd-sockets::host-ent-address
+ 				      (sb-bsd-sockets:get-host-by-name host))
+ 				     port)
+       (sb-bsd-sockets:socket-make-stream
+        socket :input t :output t :buffering (if bin :none :line)
+        :element-type (if bin '(unsigned-byte 8) 'character)))
      #-(or abcl allegro clisp cmu gcl lispworks mcl
!           (and sbcl (or net.sbcl.sockets db-sockets sb-bsd-sockets)) scl)
      (error 'not-implemented :proc (list 'open-socket host port bin))))
  
  (defun set-socket-stream-format (socket format)
***************
*** 233,240 ****
--- 248,274 ----
    #-(or acl clisp cmu lispworks scl)
    (error 'not-implemented :proc (list 'set-socket-stream-format socket format)))
  
+ 
+ 
+ 
+ #+(and sbcl sb-bsd-sockets)
+ (defun funcall-on-sock (function sock)
+   "Apply function (getsockname/getpeername) on socket, return host/port as two values"
+   (let ((sockaddr (sockint::allocate-sockaddr-in)))
+     (funcall function (sb-sys:fd-stream-fd sock) sockaddr sockint::size-of-sockaddr-in)
+     (let ((host (coerce (loop for i from 0 below 4
+ 			      collect (sb-alien:deref (sockint::sockaddr-in-addr sockaddr) i))
+ 			'(vector (unsigned-byte 8) 4)))
+ 	  (port (+ (* 256 (sb-alien:deref (sockint::sockaddr-in-port sockaddr) 0))
+ 		   (sb-alien:deref (sockint::sockaddr-in-port sockaddr) 1))))
+       (sockint::free-sockaddr-in sockaddr)
+       (values host port))))
+       
+ 
+ 
  (defun socket-host/port (sock)
    "Return the remote and local host&port, as 4 values."
+   #-(and sbcl sb-bsd-sockets)
    (declare (type socket sock))
    #+allegro (values (socket:ipaddr-to-dotted (socket:remote-host sock))
                      (socket:remote-port sock)
***************
*** 279,286 ****
                  local-port))))
    #+(and sbcl net.sbcl.sockets)
    (net.sbcl.sockets:socket-host-port sock)
    #-(or allegro clisp cmu gcl lispworks mcl
!         (and sbcl (or net.sbcl.sockets db-sockets)) scl)
    (error 'not-implemented :proc (list 'socket-host/port sock)))
  
  (defun socket-string (sock)
--- 313,329 ----
                  local-port))))
    #+(and sbcl net.sbcl.sockets)
    (net.sbcl.sockets:socket-host-port sock)
+   #+(and sbcl sb-bsd-sockets)
+   (multiple-value-bind (remote remote-port)
+       (funcall-on-sock #'sockint::getpeername sock)
+     (multiple-value-bind (local local-port)
+ 	(funcall-on-sock #'sockint::getsockname sock)
+       (values (ipaddr-to-dotted (vector-to-ipaddr remote))
+ 	      remote-port
+ 	      (ipaddr-to-dotted (vector-to-ipaddr local))
+ 	      local-port)))
    #-(or allegro clisp cmu gcl lispworks mcl
!         (and sbcl (or net.sbcl.sockets db-sockets sb-bsd-sockets)) scl)
    (error 'not-implemented :proc (list 'socket-host/port sock)))
  
  (defun socket-string (sock)
***************
*** 307,312 ****
--- 350,356 ----
    #+mcl 'ccl::listener-socket
    #+(and sbcl db-sockets) 'sb-sys:fd-stream
    #+(and sbcl net.sbcl.sockets) 'net.sbcl.sockets:passive-socket
+   #+(and sbcl sb-bsd-sockets) 'sb-bsd-sockets:inet-socket
    #-(or abcl allegro clisp cmu gcl mcl
          (and sbcl (or net.sbcl.sockets db-sockets)) scl) t)
  
***************
*** 336,343 ****
      (sockets:socket-bind socket (vector 0 0 0 0) (or port 0)))
    #+(and sbcl net.sbcl.sockets)
    (net.sbcl.sockets:make-socket 'net.sbcl.sockets:passive-socket :port port)
    #-(or abcl allegro clisp cmu gcl lispworks mcl
!         (and sbcl (or net.sbcl.sockets db-sockets)) scl)
    (error 'not-implemented :proc (list 'open-socket-server port)))
  
  (defun socket-accept (serv &key bin wait)
--- 380,395 ----
      (sockets:socket-bind socket (vector 0 0 0 0) (or port 0)))
    #+(and sbcl net.sbcl.sockets)
    (net.sbcl.sockets:make-socket 'net.sbcl.sockets:passive-socket :port port)
+   #+(and sbcl sb-bsd-sockets)
+   (let ((sock (make-instance 'sb-bsd-sockets:inet-socket
+                              :type :stream
+                              :protocol :tcp)))
+     (setf (sb-bsd-sockets:sockopt-reuse-address sock) t)
+     (sb-bsd-sockets:socket-bind  sock (vector 0 0 0 0) (or port 0))
+     (sb-bsd-sockets:socket-listen sock 15)
+     sock)
    #-(or abcl allegro clisp cmu gcl lispworks mcl
!         (and sbcl (or net.sbcl.sockets db-sockets sb-bsd-sockets)) scl)
    (error 'not-implemented :proc (list 'open-socket-server port)))
  
  (defun socket-accept (serv &key bin wait)
***************
*** 346,352 ****
   BIN - create a binary stream;
   WAIT - wait for the connection this many seconds
          (the default is NIL - wait forever).
! Returns a socket stream or NIL."
    (declare (type socket-server serv)
             #+(or (and allegro (version>= 6)) openmcl)
             (ignore bin))
--- 398,405 ----
   BIN - create a binary stream;
   WAIT - wait for the connection this many seconds
          (the default is NIL - wait forever).
! Returns a socket stream or NIL.
! Note: with sbcl and sb-bsd-sockets, the socket is returned as second value"
    (declare (type socket-server serv)
             #+(or (and allegro (version>= 6)) openmcl)
             (ignore bin))
***************
*** 404,411 ****
         'net.sbcl.sockets:binary-stream-socket
         'net.sbcl.sockets:character-stream-socket)
     :wait wait)
    #-(or abcl allegro clisp cmu gcl lispworks mcl
!         (and sbcl (or net.sbcl.sockets db-sockets)) scl)
    (error 'not-implemented :proc (list 'socket-accept serv bin)))
  
  (defun socket-server-close (server)
--- 457,474 ----
         'net.sbcl.sockets:binary-stream-socket
         'net.sbcl.sockets:character-stream-socket)
     :wait wait)
+   #+(and sbcl sb-bsd-sockets)
+   (progn
+     (setf (sb-bsd-sockets:non-blocking-mode serv) wait)
+     (let ((s (sb-bsd-sockets:socket-accept serv)))
+       (if s
+ 	  (sb-bsd-sockets:socket-make-stream s
+ 					     :input t :output t
+ 					     :element-type (if bin '(unsigned-byte 8) 'character)
+ 					     :buffering (if bin :full :line))
+ 	  (sleep wait))))
    #-(or abcl allegro clisp cmu gcl lispworks mcl
!         (and sbcl (or net.sbcl.sockets db-sockets sb-bsd-sockets)) scl)
    (error 'not-implemented :proc (list 'socket-accept serv bin)))
  
  (defun socket-server-close (server)
***************
*** 421,428 ****
    #+openmcl (close server)
    #+(and sbcl db-sockets) (sockets:socket-close server)
    #+(and sbcl net.sbcl.sockets) (close server)
    #-(or abcl allegro clisp cmu gcl lispworks openmcl
!         (and sbcl (or net.sbcl.sockets db-sockets)) scl)
    (error 'not-implemented :proc (list 'socket-server-close server)))
  
  (defun socket-server-host/port (server)
--- 484,492 ----
    #+openmcl (close server)
    #+(and sbcl db-sockets) (sockets:socket-close server)
    #+(and sbcl net.sbcl.sockets) (close server)
+   #+(and sbcl sb-bsd-sockets) (sb-bsd-sockets:socket-close server)
    #-(or abcl allegro clisp cmu gcl lispworks openmcl
!         (and sbcl (or net.sbcl.sockets db-sockets sb-bsd-sockets)) scl)
    (error 'not-implemented :proc (list 'socket-server-close server)))
  
  (defun socket-server-host/port (server)
***************
*** 451,458 ****
      (values (vector-to-ipaddr addr) port))
    #+(and sbcl net.sbcl.sockets)
    (net.sbcl.sockets:passive-socket-host-port server)
    #-(or allegro clisp cmu gcl lispworks openmcl
!         (and sbcl (or net.sbcl.sockets db-sockets)) scl)
    (error 'not-implemented :proc (list 'socket-server-host/port server)))
  
  ;;;
--- 515,525 ----
      (values (vector-to-ipaddr addr) port))
    #+(and sbcl net.sbcl.sockets)
    (net.sbcl.sockets:passive-socket-host-port server)
+   #+(and sbcl sb-bsd-sockets)
+   (multiple-value-bind (addr port) (sb-bsd-sockets:socket-name server)
+     (values (ipaddr-to-dotted (vector-to-ipaddr addr)) port))
    #-(or allegro clisp cmu gcl lispworks openmcl
!         (and sbcl (or net.sbcl.sockets db-sockets sb-bsd-sockets)) scl)
    (error 'not-implemented :proc (list 'socket-server-host/port server)))
  
  ;;;

--=-=-=
Content-Type: text/plain; charset="us-ascii"
MIME-Version: 1.0
Content-Transfer-Encoding: 7bit
Content-Disposition: inline

Using Tomcat but need to do more? Need to support web services, security?
Get stuff done quickly with pre-integrated technology to make your job easier
Download IBM WebSphere Application Server v.1.0.1 based on Apache Geronimo
http://sel.as-us.falkag.net/sel?cmd=lnk&kid=120709&bid=263057&dat=121642

--=-=-=
Content-Type: text/plain; charset="us-ascii"
MIME-Version: 1.0
Content-Transfer-Encoding: 7bit
Content-Disposition: inline

_______________________________________________
clocc-list mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/clocc-list

--=-=-=--