diff options
Diffstat (limited to 'ebus-racket')
| -rwxr-xr-x | ebus-racket/dumper.rkt | 48 | ||||
| -rw-r--r-- | ebus-racket/layer2.rkt | 57 | ||||
| -rw-r--r-- | ebus-racket/layer7.rkt | 142 |
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 |