[usocket-cvs] r319 - usocket/trunk

ehuelsmann at common-lisp.net ehuelsmann at common-lisp.net
Wed Feb 20 21:47:47 UTC 2008


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
 ;;



More information about the usocket-cvs mailing list