Browse files

Commented out a lot of old code that is to be replaced.

This means that we cannot send a "Hello" message at the moment, but we're getting there...
  • Loading branch information...
1 parent 625c19f commit 2c69b47ad5fdd12c382234e24b301f92a64a9584 @blitz committed Feb 4, 2009
Showing with 194 additions and 164 deletions.
  1. +14 −0 README
  2. +131 −156 network.lisp
  3. +20 −0 packages.lisp
  4. +29 −8 types.lisp
View
14 README
@@ -20,6 +20,20 @@ There is currently no fancy project page, bug tracker or
whatever. Please coordinate your effort with js at alien8 dot de or
use github's communication methods to reach me.
+* Some notes
+
+** Implementation-specific code
+
+An effort has been made to include no implementation-specific code,
+but to rely on various wrapper libraries. This increases the amount of
+dependencies somewhat, but frees CL-DBUS from a lot of clutter.
+
+** Endianness
+
+Due to simplicity I plan only to support host endianness for outgoing
+messages, i.e. every message we compose ourselves. Incoming messages
+should be parsable regardless of their endianness.
+
* Information
The D-BUS spec: http://dbus.freedesktop.org/doc/dbus-specification.html
View
287 network.lisp
@@ -59,171 +59,146 @@ address. Defaults to :SESSION."
;;; Method calls
-(defvar *endianness* :little-endian)
-(defvar *byte-counter*)
-
-(defun dbus-read-alignment (stream alignment)
- "Skip bytes to achieve an alignment of ALIGNMENT bytes."
- (let ((mod (nth-value 1 (truncate *byte-counter* alignment))))
- (unless (zerop mod)
- (iter (repeat (- alignment mod))
- (dbus-read-byte stream)))))
-
-(defun dbus-read-byte (stream)
- (incf *byte-counter* 1)
- (read-byte stream))
-
-(defun dbus-read-uint16 (stream)
- (dbus-read-alignment stream 2)
- (ecase *endianness*
- (:little-endian
- (logior (dbus-read-byte stream)
- (ash (dbus-read-byte stream) 8)))
- (:big-endian
- (logior (ash (dbus-read-byte stream) 8)
- (dbus-read-byte stream)))))
-
-(defun dbus-read-uint32 (stream)
- (dbus-read-alignment stream 4)
- (ecase *endianness*
- (:little-endian
- (logior (dbus-read-byte stream)
- (ash (dbus-read-byte stream) 8)
- (ash (dbus-read-byte stream) 16)
- (ash (dbus-read-byte stream) 24)))
- (:big-endian
- (logior (ash (dbus-read-byte stream) 24)
- (ash (dbus-read-byte stream) 16)
- (ash (dbus-read-byte stream) 8)
- (dbus-read-byte stream)))))
-
-(defun dbus-read-string (stream)
- (let ((length (dbus-read-uint32 stream)))
- (when (> length (* 1024 1024))
- (cerror "This is okay. Continue." "Incredibly large string (~,2F MB) in DBUS request."
- (/ length 1024 1024)))
- (let* ((buf (make-array length :element-type '(unsigned-byte 8)))
- (bytes (read-sequence buf stream)))
- (assert (= bytes length))
- (incf *byte-counter* bytes)
- (assert (zerop (dbus-read-byte stream)))
- (babel:octets-to-string buf :encoding :utf-8))))
-
-(defun dbus-read-signature (stream)
- (let* ((length (dbus-read-byte stream))
- (buf (make-array length :element-type '(unsigned-byte 8)))
- (bytes (read-sequence buf stream)))
- (assert (= length bytes))
- (assert (zerop (dbus-read-byte stream)))
- (babel:octets-to-string buf :encoding :utf-8)))
-
-;;; Message type
-(defconstant +method-call+ 1)
-(defconstant +method-return+ 2)
-(defconstant +error+ 3)
-(defconstant +signal+ 4)
-
-;;; Header fields
-(defconstant +path+ 1)
-(defconstant +interface+ 2)
-(defconstant +member+ 3)
-(defconstant +error-name+ 4)
-(defconstant +reply-serial+ 5)
-(defconstant +destination+ 6)
-(defconstant +sender+ 7)
-(defconstant +signature+ 8)
-
-;;; Header flags
-(defconstant +no-reply-expected+ #x1)
-(defconstant +no-auto-start+ #x2)
-
-(defconstant +dbus-major-version+ 1)
-
-(defun dbus-write-byte (stream byte)
- (declare (type (unsigned-byte 8) byte))
- (incf *byte-counter*)
- (write-byte byte stream))
-
-(defun dbus-write-alignment (stream alignment)
- "Insert padding to achieve an alignment of ALIGNMENT bytes."
- (let ((mod (nth-value 1 (truncate *byte-counter* alignment))))
- (unless (zerop mod)
- (format t "Emitting ~A byte(s) alignment.~%" (- alignment mod))
- (iter (repeat (- alignment mod))
- (dbus-write-byte stream 0)))))
-
-
-(defun dbus-write-uint32 (stream uint32)
- (declare (type (unsigned-byte 32) uint32))
- (format t "Emitting UINT32: #x~X~%" uint32)
- (dbus-write-alignment stream 4)
- (let ((buf (make-array 4 :element-type '(unsigned-byte 8))))
- (declare (dynamic-extent buf))
- (ecase *endianness*
- (:little-endian
- (setf (aref buf 0) (logand uint32 #xFF)
- (aref buf 1) (logand (ash uint32 -8) #xFF)
- (aref buf 2) (logand (ash uint32 -16) #xFF)
- (aref buf 3) (logand (ash uint32 -24) #xFF)))
- (:big-endian
- (setf (aref buf 0) (logand (ash uint32 -24) #xFF)
- (aref buf 1) (logand (ash uint32 -16) #xFF)
- (aref buf 2) (logand (ash uint32 -8) #xFF)
- (aref buf 3) (logand uint32 #xFF))))
- (write-sequence buf stream)
- (incf *byte-counter* 4)))
-
-(defun dbus-write-signature (stream sig)
- (format t "Emitting signature: ~A~%" sig)
- ;; XXX Merge with dbus-write-string?
- (let ((buf (flex:string-to-octets sig)))
- (dbus-write-byte stream (length buf))
- (write-sequence buf stream)
- (incf *byte-counter* (length buf))
- (dbus-write-byte stream 0)))
-
-(defun dbus-write-string (stream string)
- (format t "Emitting string: ~A~%" string)
- (let ((buf (flex:string-to-octets string)))
- (dbus-write-uint32 stream (length buf))
- (write-sequence buf stream)
- (incf *byte-counter* (length buf))
- (dbus-write-byte stream 0)))
-
-(defmacro dbus-with-array-write ((stream-var output-stream alignment) &body body)
- (let ((out-var (gensym "OUT-VAR"))
- (ali-var (gensym "ALI-VAR")))
- `(let ((,out-var ,output-stream)
- (,ali-var ,alignment)
- (buf (flexi-streams:with-output-to-sequence (,stream-var)
- (let ((*byte-counter* 0))
- ,@body))))
- (format t "BC before array = ~A~%" *byte-counter*)
- (dbus-write-uint32 ,out-var (length buf))
- (dbus-write-alignment stream ,ali-var)
- (format t "Writing array body with ~A bytes.~%" (length buf))
- (write-sequence buf ,out-var)
- (incf *byte-counter* (length buf))
- (format t "BC after array = ~A~%" *byte-counter*)
- )))
-
-(defun dbus-marshal-to-buffer (signature arguments)
- (flexi-streams:with-output-to-sequence (out)
- (with-input-from-string (sig signature)
- )
- )
- )
-
+;; (defvar *endianness* :little-endian)
+;; (defvar *byte-counter*)
+
+;; (defun dbus-read-alignment (stream alignment)
+;; "Skip bytes to achieve an alignment of ALIGNMENT bytes."
+;; (let ((mod (nth-value 1 (truncate *byte-counter* alignment))))
+;; (unless (zerop mod)
+;; (iter (repeat (- alignment mod))
+;; (dbus-read-byte stream)))))
+
+;; (defun dbus-read-byte (stream)
+;; (incf *byte-counter* 1)
+;; (read-byte stream))
+
+;; (defun dbus-read-uint16 (stream)
+;; (dbus-read-alignment stream 2)
+;; (ecase *endianness*
+;; (:little-endian
+;; (logior (dbus-read-byte stream)
+;; (ash (dbus-read-byte stream) 8)))
+;; (:big-endian
+;; (logior (ash (dbus-read-byte stream) 8)
+;; (dbus-read-byte stream)))))
+
+;; (defun dbus-read-uint32 (stream)
+;; (dbus-read-alignment stream 4)
+;; (ecase *endianness*
+;; (:little-endian
+;; (logior (dbus-read-byte stream)
+;; (ash (dbus-read-byte stream) 8)
+;; (ash (dbus-read-byte stream) 16)
+;; (ash (dbus-read-byte stream) 24)))
+;; (:big-endian
+;; (logior (ash (dbus-read-byte stream) 24)
+;; (ash (dbus-read-byte stream) 16)
+;; (ash (dbus-read-byte stream) 8)
+;; (dbus-read-byte stream)))))
+
+;; (defun dbus-read-string (stream)
+;; (let ((length (dbus-read-uint32 stream)))
+;; (when (> length (* 1024 1024))
+;; (cerror "This is okay. Continue." "Incredibly large string (~,2F MB) in DBUS request."
+;; (/ length 1024 1024)))
+;; (let* ((buf (make-array length :element-type '(unsigned-byte 8)))
+;; (bytes (read-sequence buf stream)))
+;; (assert (= bytes length))
+;; (incf *byte-counter* bytes)
+;; (assert (zerop (dbus-read-byte stream)))
+;; (babel:octets-to-string buf :encoding :utf-8))))
+
+;; (defun dbus-read-signature (stream)
+;; (let* ((length (dbus-read-byte stream))
+;; (buf (make-array length :element-type '(unsigned-byte 8)))
+;; (bytes (read-sequence buf stream)))
+;; (assert (= length bytes))
+;; (assert (zerop (dbus-read-byte stream)))
+;; (babel:octets-to-string buf :encoding :utf-8)))
+
+;; (defun dbus-write-byte (stream byte)
+;; (declare (type (unsigned-byte 8) byte))
+;; (incf *byte-counter*)
+;; (write-byte byte stream))
+
+;; (defun dbus-write-alignment (stream alignment)
+;; "Insert padding to achieve an alignment of ALIGNMENT bytes."
+;; (let ((mod (nth-value 1 (truncate *byte-counter* alignment))))
+;; (unless (zerop mod)
+;; (format t "Emitting ~A byte(s) alignment.~%" (- alignment mod))
+;; (iter (repeat (- alignment mod))
+;; (dbus-write-byte stream 0)))))
+
+
+;; (defun dbus-write-uint32 (stream uint32)
+;; (declare (type (unsigned-byte 32) uint32))
+;; (format t "Emitting UINT32: #x~X~%" uint32)
+;; (dbus-write-alignment stream 4)
+;; (let ((buf (make-array 4 :element-type '(unsigned-byte 8))))
+;; (declare (dynamic-extent buf))
+;; (ecase *endianness*
+;; (:little-endian
+;; (setf (aref buf 0) (logand uint32 #xFF)
+;; (aref buf 1) (logand (ash uint32 -8) #xFF)
+;; (aref buf 2) (logand (ash uint32 -16) #xFF)
+;; (aref buf 3) (logand (ash uint32 -24) #xFF)))
+;; (:big-endian
+;; (setf (aref buf 0) (logand (ash uint32 -24) #xFF)
+;; (aref buf 1) (logand (ash uint32 -16) #xFF)
+;; (aref buf 2) (logand (ash uint32 -8) #xFF)
+;; (aref buf 3) (logand uint32 #xFF))))
+;; (write-sequence buf stream)
+;; (incf *byte-counter* 4)))
+
+;; (defun dbus-write-signature (stream sig)
+;; (format t "Emitting signature: ~A~%" sig)
+;; ;; XXX Merge with dbus-write-string?
+;; (let ((buf (flex:string-to-octets sig)))
+;; (dbus-write-byte stream (length buf))
+;; (write-sequence buf stream)
+;; (incf *byte-counter* (length buf))
+;; (dbus-write-byte stream 0)))
+
+;; (defun dbus-write-string (stream string)
+;; (format t "Emitting string: ~A~%" string)
+;; (let ((buf (flex:string-to-octets string)))
+;; (dbus-write-uint32 stream (length buf))
+;; (write-sequence buf stream)
+;; (incf *byte-counter* (length buf))
+;; (dbus-write-byte stream 0)))
+
+;; (defmacro dbus-with-array-write ((stream-var output-stream alignment) &body body)
+;; (let ((out-var (gensym "OUT-VAR"))
+;; (ali-var (gensym "ALI-VAR")))
+;; `(let ((,out-var ,output-stream)
+;; (,ali-var ,alignment)
+;; (buf (flexi-streams:with-output-to-sequence (,stream-var)
+;; (let ((*byte-counter* 0))
+;; ,@body))))
+;; (format t "BC before array = ~A~%" *byte-counter*)
+;; (dbus-write-uint32 ,out-var (length buf))
+;; (dbus-write-alignment stream ,ali-var)
+;; (format t "Writing array body with ~A bytes.~%" (length buf))
+;; (write-sequence buf ,out-var)
+;; (incf *byte-counter* (length buf))
+;; (format t "BC after array = ~A~%" *byte-counter*)
+;; )))
+
+;; (defun dbus-marshal-to-buffer (signature arguments)
+;; (flexi-streams:with-output-to-sequence (out)
+;; (with-input-from-string (sig signature)
+;; )))
; method call sender=:1.4 -> dest=org.freedesktop.DBus path=/org/freedesktop/DBus; interface=org.freedesktop.DBus; member=Hello
-
(defun dbus-method-call (con &key path interface member signature arguments
destination
(serial 1)
(reply-expected t)
(auto-start t))
(assert (and member path))
+ #+ ignore
(let ((stream (stream-of con))
(body (dbus-marshal-to-buffer signature arguments))
(*byte-counter* 0))
View
20 packages.lisp
@@ -9,6 +9,26 @@
(:export))
(in-package :blitz.desktop.dbus)
+;;; Message type
+(defconstant +method-call+ 1)
+(defconstant +method-return+ 2)
+(defconstant +error+ 3)
+(defconstant +signal+ 4)
+;;; Header fields
+(defconstant +path+ 1)
+(defconstant +interface+ 2)
+(defconstant +member+ 3)
+(defconstant +error-name+ 4)
+(defconstant +reply-serial+ 5)
+(defconstant +destination+ 6)
+(defconstant +sender+ 7)
+(defconstant +signature+ 8)
+
+;;; Header flags
+(defconstant +no-reply-expected+ #x1)
+(defconstant +no-auto-start+ #x2)
+
+(defconstant +dbus-major-version+ 1)
;;; EOF
View
37 types.lisp
@@ -45,21 +45,42 @@
(defgeneric marshall (type object vector start)
(:documentation "Marshalls OBJECT (interpreted as TYPE) into
VECTOR (starting at START). Returns VECTOR and an index pointing
- after the written data."))
+ after the written data. VECTOR is destructively modified!"))
-(defun dbus-write-byte (vector start byte &optional (repeat 1))
+(defun dbus-write-byte (vector byte start &optional (repeat 1))
+ "Writes BYTE REPEAT-times into VECTOR starting at START. Returns the
+new position in VECTOR."
(iter (repeat repeat)
(for i upfrom 0)
- (setf (aref vector (+ start i)) byte)))
+ (setf (aref vector (+ start i)) byte))
+ (+ start repeat))
+
+(defun dbus-write-sequence (destination source start)
+ "Writes SOURCE into DESTINATION (both vectors) starting at
+ START. Returns the new position in DESTINATION."
+ (when (> (+ (length source) start)
+ (length destination))
+ (error "Vector too small."))
+ (setf (subseq destination start) source)
+ (+ start (length source)))
(defmethod marshall :around ((type dbus-type) object vector start)
+ ;; Alignment is handled in this around method.
(let* ((alignment (alignment-of type))
(mod (nth-value 1 (truncate start alignment))))
- (dbus-write-byte vector start 0 (- alignment mod))
- (call-next-method type object vector (+ start (- alignment mod)))))
+ (format t "~A ~A~%" alignment mod)
+ (values
+ (call-next-method type object vector
+ (dbus-write-byte vector 0 start
+ (mod (- alignment mod) alignment)))
+ vector)))
(defmethod marshall ((type dbus-boolean) object vector start)
- ;; Endianness?
- ;; XXXX
- )
+ (dbus-write-sequence vector
+ (if object
+ #+ little-endian #(1 0 0 0)
+ #+ big-endian #(0 0 0 1)
+ #(0 0 0 0))
+ start))
+
;;; EOF

0 comments on commit 2c69b47

Please sign in to comment.