ebus-racket:

  * dumper
    * use racket/base
    * use racket/pretty pretty-print
    * support layer7 parser (--layer7)
  * layer2
    * define constants as #xHEX values
      instead of bytestrings
  * layer7
    * support more datatypes
  * reformat with emacs
  * layer7
    * support more datatypes
  * reformat with emacs

3 files changed, 174 insertions, 73 deletions

diff --git a/ebus-racket/dumper.rkt b/ebus-racket/dumper.rkt
index 3c66015..7ffd556 100755
--- a/ebus-racket/dumper.rkt
+++ b/ebus-racket/dumper.rkt
@@ -1,27 +1,51 @@
 #! /usr/bin/env racket
-#lang racket
-
-(require "layer2.rkt")
+#lang racket/base
+(require racket/cmdline
+         racket/tcp
+	 racket/pretty
+         "layer2.rkt"
+	 "layer7.rkt")
 
 ;(define verbose? (make-parameter #f))
 (define connect-host? (make-parameter null))
 (define connect-port? (make-parameter null))
+(define layer7? (make-parameter #f))
 
 (define greeting
   (command-line
    #:once-each
-;   [("-v") "Verbose mode" (verbose? #t)]
-   [("-c" "--connect") host port
-                       "Connect to server <host> <port>"
-                       (connect-host? host)
-                       (connect-port? (string->number port))
-                       ]))
+   [("-a" "--layer7")
+    "Parse Layer7" (layer7? #t)]
+   [("-c" "--connect") 
+    host port
+    "Connect to server <host> <port>"
+    (connect-host? host)
+    (connect-port? (string->number port))
+    ]))
+
 ; Connect
 (if (or (null? (connect-host?)) (null? (connect-port?)))
-    (display "Using stdin")
+    (display "Using stdin\n")
     (let-values ([(cin cout) (tcp-connect (connect-host?) (connect-port?))])
       (display (format "Connected to ~s ~s ~n" (connect-host?) (connect-port?)))
       (current-input-port cin)))
 
-;
-(layer2-read-ebus-loop (current-input-port))
+(define (read-ebus-loop2 input-port)
+  (let ([paket (layer2-read-ebus (current-input-port))])
+    (pretty-print paket)
+    (cond ((not (eof-object? paket)) (read-ebus-loop2 input-port)))))
+
+(define (read-ebus-loop7 input-port)
+  (let ([fields (layer7-read-ebus (current-input-port))])
+    (if (not (void? fields))
+	(pretty-print fields)
+	(display ""))
+    (cond ((not (eof-object? fields)) (read-ebus-loop7 input-port)))))
+
+(if (layer7?)
+    (let ()
+      (display "Layer 7\n")
+      (read-ebus-loop7 (current-input-port)))
+    (let ()
+      (display "Layer 2\n")
+      (read-ebus-loop2 (current-input-port))))
diff --git a/ebus-racket/layer2.rkt b/ebus-racket/layer2.rkt
index dbdd411..42d50b3 100644
--- a/ebus-racket/layer2.rkt
+++ b/ebus-racket/layer2.rkt
@@ -1,10 +1,14 @@
-#lang racket
-(require (planet bzlib/parseq:1:3))
-
-; Ebus SYN Byte-String
-(define ebus-const-syn (string->bytes/latin-1 "\xaa"))
-(define ebus-const-escape (string->bytes/latin-1 "\xa9"))
-(define ebus-const-ackok (string->bytes/latin-1 "\x00"))
+#lang racket/base
+(require racket/bool
+         (planet bzlib/parseq:1:3))
+
+;; Ebus SYN
+(define ebus-const-syn #xaa)
+;; Ebus Escape-Sequence Start
+(define ebus-const-escape #xa9)
+;; Ebus ACK
+(define ebus-const-ackok #x00)
+;; Ebus Broadcast Address
 (define ebus-const-broadcastaddr 254)
 
 (struct ebus-body-broadcast (crc) #:transparent)
@@ -12,38 +16,38 @@
 (struct ebus-body-mastermaster (crc) #:transparent)
 
 (struct ebus-body-masterslave
-  (crc payloadSlaveLength payloadSlave crcSlave)
-  #:transparent)
+	(crc payloadSlaveLength payloadSlave crcSlave)
+	#:transparent)
 
 (struct ebus-paket
-  (source destination primaryCommand secondaryCommand payloadLength payload body)
-  #:transparent)
+	(source destination primaryCommand secondaryCommand payloadLength payload body)
+	#:transparent)
 
 ;; single, maybe escaped, payload data byte 
-(define ebus-payload (choice (seq escape-seq <- (bytes= ebus-const-escape)
+(define ebus-payload (choice (seq escape-seq <- ebus-const-escape
                                   escape-code <- (byte-in (list 0 1))
                                   (return (cond
-                                            ((= escape-code 0) ebus-const-escape)
-                                            ((= escape-code 1) ebus-const-syn))))
+					   ((= escape-code 0) ebus-const-escape)
+					   ((= escape-code 1) bytes ebus-const-syn))))
                              any-byte
                              ))
 
 (define parse-ebus-broadcast (token (seq crc <- any-byte
-                                         syn <- (bytes= ebus-const-syn)
+                                         syn <- ebus-const-syn
                                          (return (ebus-body-broadcast crc)))))
 
 (define parse-ebus-mastermaster (token (seq  crc <- any-byte
-                                             ack <- (bytes= ebus-const-ackok) ; ACK des Empfängers
-                                             syn <- (bytes= ebus-const-syn)   ; SYN des Senders
+                                             ack <- ebus-const-ackok ;; ACK des Empfängers
+                                             syn <- ebus-const-syn   ;; SYN des Senders
                                              (return (ebus-body-mastermaster crc)))))
 
 (define parse-ebus-masterslave (token (seq crc <- any-byte
-                                           ack <- (bytes= ebus-const-ackok) ;ACK des Empfängers
+                                           ack <- ebus-const-ackok ;; ACK des Empfängers
                                            payloadSlaveLength <- any-byte
                                            payloadSlave <- (repeat ebus-payload payloadSlaveLength payloadSlaveLength)
                                            crcSlave <- any-byte
-                                           ackSlave <- (bytes= ebus-const-ackok) ;ACK des Senders
-                                           synSlave <- (bytes= ebus-const-syn)   ;SYN des Senders
+                                           ackSlave <- ebus-const-ackok ;; ACK des Senders
+                                           synSlave <- ebus-const-syn   ;; SYN des Senders
                                            (return (ebus-body-masterslave crc payloadSlaveLength payloadSlave crcSlave)))))
 
 (define parse-ebus-master-or-slave (token (choice parse-ebus-mastermaster parse-ebus-masterslave)))
@@ -68,7 +72,6 @@
                           (return (length syncs))))
 
 
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define (read-ebus input-port)
@@ -81,19 +84,13 @@
           ((eof-object? (peek-byte input-port))
            eof)
           (else
-           (display (format "drop ~s ~n" (peek-byte input-port)))
-           ; skip one byte
+	   (let ([byte (read-byte input-port)])
+	     (display (format "drop ~s 0x~x ~n" byte byte)))
+	   ;; skip one byte
            (read-byte input-port)
-           ;(file-position input-port (+ 1 (file-position input-port)))
            (read-ebus input-port)))))
 
-(define (read-ebus-loop input-port)
-  (let ([paket (read-ebus (current-input-port))])
-    (display (format "Paket ~s~n" paket))
-    (cond ((not (eof-object? paket)) (read-ebus-loop input-port)))))
-
 (provide (prefix-out layer2- read-ebus)
-         (prefix-out layer2- read-ebus-loop)
          (prefix-out layer2- (struct-out ebus-paket))
          (prefix-out layer2- (struct-out ebus-body-broadcast))
          (prefix-out layer2- (struct-out ebus-body-mastermaster))
diff --git a/ebus-racket/layer7.rkt b/ebus-racket/layer7.rkt
index 8f8f39e..5cb4477 100644
--- a/ebus-racket/layer7.rkt
+++ b/ebus-racket/layer7.rkt
@@ -1,5 +1,6 @@
-#lang racket
-(require (planet lizorkin/sxml:2:1/sxml)
+#lang racket/base
+(require racket/list
+         (planet lizorkin/sxml:2:1/sxml)
          (planet lizorkin/ssax:2:0/ssax)
          "layer2.rkt")
 
@@ -26,30 +27,56 @@
 
 
 (define (paket-fields ebus-paket)
-  (let* ([paket-definition (paket ebus-paket)]
-         [paket-name (first ((sxpath "@name/text()") paket-definition))]
-         [fields ((sxpath "fields/*") paket-definition)]
-         [values (for/list ([field fields])
-                        (let ([datatype ((sxpath "name()") field)]
-                              [name (string-append paket-name "." (first ((sxpath "@name/text()") field)))]
-                              [offset (string->number (first ((sxpath "@offset/text()") field)))])
-                          (cond ((string=? "bit" datatype)
-                                 (list name datatype offset
-                                       (field-decoder-bit (list-ref (layer2-ebus-paket-payload ebus-paket) offset))))
-                                ((string=? "data1b" datatype)
-                                 (list name datatype offset
-                                       (field-decoder-data1b (list-ref (layer2-ebus-paket-payload ebus-paket) offset))))
-                                ((string=? "data2b" datatype)
-                                 (list name datatype offset
-                                       (field-decoder-data2b (list-ref (layer2-ebus-paket-payload ebus-paket) offset)
-                                                             (list-ref (layer2-ebus-paket-payload ebus-paket) (+ offset 1)))))
-                                (else (display (string-append "unknown datatype: " datatype))
-                                      (void)))
-                          ))])
-    ; filter invalid values
-    (for/list ([value values] #:when (not (void? value)))
-      value)))
-  
+  (let ([paket-definition (paket ebus-paket)])
+    (cond ((> (length paket-definition) 0)
+	   (let* 
+	       ([paket-name (first ((sxpath "@name/text()") paket-definition))]
+		[fields ((sxpath "fields/*") paket-definition)]
+		[values 
+		 (for/list ([field fields]) (paket-fields-dispatch-decoder ebus-paket field paket-name))])
+	     ;; filter invalid values
+	     (for/list ([value values] #:when (not (void? value)))
+		       value)))
+	  (else (display (format "Unknown Paket: ~s~n" ebus-paket))
+		(void)))))
+
+(define (paket-fields-dispatch-decoder ebus-paket field paket-name)
+  (let ([datatype ((sxpath "name()") field)]
+	[name (string-append paket-name "." (first ((sxpath "@name/text()") field)))]
+	[offset (string->number (first ((sxpath "@offset/text()") field)))]
+	[payload (layer2-ebus-paket-payload ebus-paket)])
+    (cond ((string=? "bit" datatype)
+	   (list name datatype offset
+		 (field-decoder-bit (list-ref payload offset))))
+	  ((string=? "bcd" datatype)
+	   (list name datatype offset
+		 (field-decoder-bcd (list-ref payload offset))))
+	  ((string=? "data1b" datatype)
+	   (list name datatype offset
+		 (field-decoder-data1b (list-ref payload offset))))
+	  ((string=? "data1c" datatype)
+	   (list name datatype offset
+		 (field-decoder-data1c (list-ref (layer2-ebus-paket-payload ebus-paket) offset))))
+	  ((string=? "byte" datatype)
+	   (list name datatype offset (list-ref payload offset)))
+	  ((string=? "data2b" datatype)
+	   (list name datatype offset
+		 (field-decoder-data2b (list-ref payload offset)
+				       (list-ref payload (+ offset 1)))))
+	  ((string=? "data2c" datatype)
+	   (list name datatype offset
+		 (field-decoder-data2c (list-ref payload offset)
+				       (list-ref payload (+ offset 1)))))
+	  ((string=? "word" datatype)
+	   (list name datatype offset
+		 (field-decoder-word (list-ref payload offset)
+				     (list-ref payload (+ offset 1)))))
+	  ((string=? "byteEnum" datatype)
+	   (list name datatype offset
+		 (field-decoder-byteEnum (list-ref payload offset) field)))
+	  (else (display (string-append "unknown datatype: " datatype "\n"))
+		(void)))))
+
 ;; type bit
 (define (field-decoder-bit value)
   (cond ((= value 1) 1)
@@ -59,14 +86,67 @@
 (define (field-decoder-data1b value)
   value)
 
+;; type data1c
+(define (field-decoder-data1c value)
+  (/ value 2.0))
+
 ;; type data2b
 (define (field-decoder-data2b lowByte highByte)
-  (cond ((= (bitwise-and highByte 128) 128)
-         (* -1 (+ (+ 256 (bitwise-not highByte))
-                  (/ (+ 256 (bitwise-not (+ lowByte 1))) 256.0))))
-         (else (+ highByte (/ lowByte 256.0)))))
+  (if (= (bitwise-and highByte 128) 128)
+      (* -1 
+	 (+ (+ 256 (bitwise-not highByte))
+	    (/ (+ 256 (bitwise-not (+ lowByte 1))) 256.0)))
+      (+ highByte (/ lowByte 256.0))))
+
+;; type data2c
+(define (field-decoder-data2c lowByte highByte)
+  (define (lowNibble v)
+    (bitwise-and v #x0f))
+  (define (highNibble v)
+    (arithmetic-shift v -4))
+  (define (u-not v)
+    (+ 256 (bitwise-not v)))
+  (if (= (bitwise-and highByte 128) 128)
+      (* -1
+	 (+ (* 16 (u-not highByte))
+	    (highNibble (u-not lowByte))
+	    (/ (lowNibble (u-not lowByte) 16))))
+      (+ (* 16 (u-not highByte))
+	 (highNibble lowByte)
+	 (/ (lowNibble lowByte) 16))))
+
+;; type byteEnum
+(define (field-decoder-byteEnum value field-definition)
+  (define (pred l)
+    (= value (list-ref l 0)))
+  (let* ([all-options (for/list ([option ((sxpath "option") field-definition)])
+				(list (string->number (first ((sxpath "@value/text()") option))) ;; value, name
+				      (first ((sxpath "@name/text()") option))))]
+	 [options (filter pred all-options)])
+    (cond ((= (length options) 1)
+	   (list-ref (first options) 1))
+	  (else "<undefined>"))))
+
+;; type word
+(define (field-decoder-word lowByte highByte)
+  (+ lowByte
+     (arithmetic-shift highByte 8)))
+
+;; type bcd
+(define (field-decoder-bcd value)
+  (+ (bitwise-and value #x0f)
+     (arithmetic-shift value -4)))
+  
+;; read one ebus-paket or eof from input-port
+;; or return #<eof>
+(define (read-ebus input-port)
+  (let* ([paket (layer2-read-ebus input-port)])
+    (cond ((layer2-ebus-paket? paket)
+	   (paket-fields paket))
+	  (else paket))))
 
 (provide (prefix-out layer7- paket)
          (prefix-out layer7- paket-fields)
          (prefix-out layer7- device)
-         (prefix-out layer7- device-name))
\ No newline at end of file
+         (prefix-out layer7- device-name)
+	 (prefix-out layer7- read-ebus))
\ No newline at end of file