From 946eb7d95fc04d465802c8fc00e5d4130a52c8f2 Mon Sep 17 00:00:00 2001 From: Random Hacker Date: Sat, 23 Feb 2013 01:32:51 +0100 Subject: racket: aufgraeumt, data2c gefixt --- ebus-racket/db-pq.rkt | 92 ------------------ ebus-racket/db.rkt | 87 ----------------- ebus-racket/doc/database-schema.sql | 18 ++++ ebus-racket/doc/sample_dump_1_1min.bin | Bin 0 -> 1300 bytes ebus-racket/dumper.rkt | 4 +- ebus-racket/ebus/db.rkt | 88 +++++++++++++++++ ebus-racket/ebus/layer2.rkt | 104 +++++++++++++++++++++ ebus-racket/ebus/layer7.rkt | 166 +++++++++++++++++++++++++++++++++ ebus-racket/inserter-pq.rkt | 121 ------------------------ ebus-racket/inserter.rkt | 20 ++-- ebus-racket/layer2-test.rkt | 71 -------------- ebus-racket/layer2.rkt | 104 --------------------- ebus-racket/layer7-test.rkt | 46 --------- ebus-racket/layer7.rkt | 158 ------------------------------- ebus-racket/tcp-repl.rkt | 35 ------- ebus-racket/tests/layer2-test.rkt | 71 ++++++++++++++ ebus-racket/tests/layer7-test.rkt | 46 +++++++++ ebus-racket/util/tcp-repl.rkt | 35 +++++++ 18 files changed, 537 insertions(+), 729 deletions(-) delete mode 100644 ebus-racket/db-pq.rkt delete mode 100644 ebus-racket/db.rkt create mode 100644 ebus-racket/doc/database-schema.sql create mode 100644 ebus-racket/doc/sample_dump_1_1min.bin create mode 100644 ebus-racket/ebus/db.rkt create mode 100644 ebus-racket/ebus/layer2.rkt create mode 100644 ebus-racket/ebus/layer7.rkt delete mode 100755 ebus-racket/inserter-pq.rkt delete mode 100644 ebus-racket/layer2-test.rkt delete mode 100644 ebus-racket/layer2.rkt delete mode 100644 ebus-racket/layer7-test.rkt delete mode 100644 ebus-racket/layer7.rkt delete mode 100644 ebus-racket/tcp-repl.rkt create mode 100644 ebus-racket/tests/layer2-test.rkt create mode 100644 ebus-racket/tests/layer7-test.rkt create mode 100644 ebus-racket/util/tcp-repl.rkt diff --git a/ebus-racket/db-pq.rkt b/ebus-racket/db-pq.rkt deleted file mode 100644 index 3b15a73..0000000 --- a/ebus-racket/db-pq.rkt +++ /dev/null @@ -1,92 +0,0 @@ -#lang racket/base -;; Database Access with synx/libpq ffi bindings -(require racket/class) -(require (prefix-in pq: (planet synx/libpq:1:3))) - -(define logger (make-logger 'ebus-db (current-logger))) - -(define con-user? (make-parameter "ebus")) -(define con-password? (make-parameter "ebus")) -(define con-database? (make-parameter "ebus")) -(define con-server? (make-parameter "localhost")) - -(define _con (void)) -(define (con) - (when (void? _con) - (log-message logger 'info (format "Connect using libpq to Database: user=~a database=~a server=~a" - (con-user?) (con-database?) (con-server?)) #t) - (set! _con - (pq:connect #:host (con-server?) - #:user (con-user?) - #:password (con-password?) - #:dbname (con-database?)))) - _con) - -(define (query-matrix stmt) - (con) - (send _con exec stmt)) - -;; Test Database Connection -;; Returns #t on success, #f otherwise -(define (pgc-test) - (with-handlers ([exn:fail? (lambda (exn) (display exn)(display "\n") #f)]) - (query-matrix "SELECT 123") - #t)) - -;; Query ID of sensor given by sensor-name -;; return void if sensor is undefined -(define (get-sensor-id sensor-name) - (define sql-stmt "SELECT id FROM sensor WHERE name = $1") - (with-handlers ([exn:fail? (lambda (exn) (void))]) - (let* ( - [result (send (con) exec sql-stmt sensor-name)] - [matrix (send result get-matrix)]) - (caar matrix)))) - -;; Create Sensor-ID with given name -;; returns id -(define (create-sensor-id sensor-name) - (log-message logger 'info (format "create sensor id for ~a" sensor-name) #t) - (define sql-stmt "INSERT INTO sensor(name) VALUES ($1)") - (send (con) exec sql-stmt sensor-name) - (get-sensor-id sensor-name)) - -;; Get ID of sensor given by sensor-name -;; define sensor if needed -(define (get-or-create-sensor-id sensor-name) - (define id (get-sensor-id sensor-name)) - (cond ((void? id) (create-sensor-id sensor-name)) - (else id))) - -;; Insert Field in Database -;; Decide Database-Datatype from Ebus-Datatype -;; then calls 'insert` -(define (insert-field sensor-name datatype offset value) - (cond ((member datatype (list "data1c" "data2b" "data2c")) - (insert sensor-name "float" (real->double-flonum value))) - ((member datatype (list "bit" "byte" "data1b" "word" "bcd")) - (insert sensor-name "int" value)) - ((member datatype (list "byteEnum")) - (insert sensor-name "string" value)) - (else - (log-message logger 'error (format "Datatype ~a is not support by DB" datatype) #t)))) - -(define (insert sensor-name type value) - (define sensor-id (get-or-create-sensor-id sensor-name)) - (log-message logger 'info (string-append (format "sensor-id=~a type=~a value=~a" - sensor-id type value)) #t) - (cond ((string=? type "string") - (send (con) p-exec "INSERT INTO value (timestamp, sensor_id, type, value_string) VALUES (now(), $1, 'string', $2)" sensor-id value)) - ((string=? type "float") - (send (con) p-exec "INSERT INTO value (timestamp, sensor_id, type, value_float) VALUES (now(), $1, 'float', $2)" sensor-id value)) - ((string=? type "int") - (send (con) p-exec "INSERT INTO value (timestamp, sensor_id, type, value_int) VALUES (now(), $1, 'int', $2::integer)" sensor-id value)))) - -(provide - (prefix-out db- logger) - (prefix-out db- con-user?) - (prefix-out db- con-password?) - (prefix-out db- con-database?) - (prefix-out db- con-server?) - (prefix-out db- pgc-test) - (prefix-out db- insert-field)) diff --git a/ebus-racket/db.rkt b/ebus-racket/db.rkt deleted file mode 100644 index 081cca7..0000000 --- a/ebus-racket/db.rkt +++ /dev/null @@ -1,87 +0,0 @@ -#lang racket/base -;; Database Acess with ryanc/db -;; leaks memory somewhere in db.plt -(require (prefix-in db: (planet ryanc/db:1:5))) -(require (prefix-in db: (planet ryanc/db:1:5/util/connect))) - -(define logger (make-logger 'ebus-db (current-logger))) - -(define con-user? (make-parameter "ebus")) -(define con-password? (make-parameter "ebus")) -(define con-database? (make-parameter "ebus")) -(define con-server? (make-parameter "localhost")) - -(define pgc - (db:virtual-connection - (lambda () - (log-message logger 'info (format "Connect to Database: user=~a database=~a server=~a" - (con-user?) (con-database?) (con-server?)) #t) - (db:postgresql-connect #:user (con-user?) - #:database (con-database?) - #:password (con-password?) - #:server (con-server?))))) - -;; Test Database Connection -;; Returns #t on success, #f otherwise -(define (pgc-test) - (with-handlers ([exn:fail? (lambda (exn) #f)]) - (= (db:query-value pgc "SELECT 1") 1))) - -;; Query ID of sensor given by sensor-name -;; Returns null if sensor is undefined -(define (get-sensor-id sensor-name) - (define sql-stmt "SELECT id FROM sensor WHERE name = $1") - (with-handlers ([exn:fail? (lambda (exn) (void))]) - (db:query-value pgc sql-stmt sensor-name))) - -;; Create Sensor-ID with given name -;; returns id -(define (create-sensor-id sensor-name) - (log-message logger 'info (format "create sensor id for ~a" sensor-name) #t) - (db:query-exec pgc "INSERT INTO sensor(name) VALUES ($1)" sensor-name) - (get-sensor-id sensor-name)) - -;; Get ID of sensor given by sensor-name -;; define sensor if needed -(define (get-or-create-sensor-id sensor-name) - (define id (get-sensor-id sensor-name)) - (cond ((void? id) (create-sensor-id sensor-name)) - (else id))) - -;; Insert Field in Database -;; Decide Database-Datatype from Ebus-Datatype -;; then calls 'insert` -(define (insert-field sensor-name datatype offset value) - (cond ((member datatype (list "data1c" "data2b" "data2c")) - ;; float - (insert sensor-name value db:sql-null db:sql-null)) - ((member datatype (list "bit" "byte" "data1b" "word" "bcd")) - ;; int - (insert sensor-name db:sql-null value db:sql-null)) - ((member datatype (list "byteEnum")) - ;; string - (insert sensor-name db:sql-null db:sql-null value)) - (else (log-message logger 'error (format "Datatype ~a is not support by DB" datatype) #t)))) - -(define (insert sensor-name value-float value-int value-string) - (define sensor-id (get-or-create-sensor-id sensor-name)) - (define type (cond ((not (db:sql-null? value-string)) "string") - ((not (db:sql-null? value-float)) "float") - ((not (db:sql-null? value-int)) "int"))) - (define sql-stmt - (string-append "INSERT INTO value(timestamp, sensor_id, type, value_float, value_int, value_string) " - "VALUES (now(), $1, $2, $3, $4, $5)")) - (log-message logger 'info (string-append sql-stmt "\n\t\t" - (format - "sensor-id=~a type=~a value-float=~a value-int=~a value-string=~a" - sensor-id type value-float value-int value-string)) #t) - (db:query-exec pgc sql-stmt sensor-id type value-float value-int value-string)) - -(provide - (prefix-out db- logger) - (prefix-out db- con-user?) - (prefix-out db- con-password?) - (prefix-out db- con-database?) - (prefix-out db- con-server?) - (prefix-out db- pgc-test) - (prefix-out db- insert-field)) diff --git a/ebus-racket/doc/database-schema.sql b/ebus-racket/doc/database-schema.sql new file mode 100644 index 0000000..281659c --- /dev/null +++ b/ebus-racket/doc/database-schema.sql @@ -0,0 +1,18 @@ +CREATE TABLE sensor ( + id INTEGER PRIMARY KEY AUTOINCREMENT, + name TEXT, + description TEXT +); +CREATE TABLE value ( + id INTEGER PRIMARY KEY AUTOINCREMENT, + "timestamp" timestamp without time zone, + sensor_id integer, + type TEXT, + value_float real, + value_int integer, + value_string TEXT, + FOREIGN KEY(sensor_id) REFERENCES sensor(id) +); +CREATE INDEX sensor_idx_001 on sensor(id); +CREATE INDEX sensor_idx_002 on sensor(name); +CREATE INDEX value_idx_001 on value(sensor_id, timestamp); diff --git a/ebus-racket/doc/sample_dump_1_1min.bin b/ebus-racket/doc/sample_dump_1_1min.bin new file mode 100644 index 0000000..f0ec73e Binary files /dev/null and b/ebus-racket/doc/sample_dump_1_1min.bin differ diff --git a/ebus-racket/dumper.rkt b/ebus-racket/dumper.rkt index cc31a16..bc60590 100755 --- a/ebus-racket/dumper.rkt +++ b/ebus-racket/dumper.rkt @@ -3,8 +3,8 @@ (require racket/cmdline racket/tcp racket/pretty - "layer2.rkt" - "layer7.rkt") + "ebus/layer2.rkt" + "ebus/layer7.rkt") ;(define verbose? (make-parameter #f)) (define connect-host? (make-parameter null)) diff --git a/ebus-racket/ebus/db.rkt b/ebus-racket/ebus/db.rkt new file mode 100644 index 0000000..2c6be6c --- /dev/null +++ b/ebus-racket/ebus/db.rkt @@ -0,0 +1,88 @@ +#lang racket/base +(require racket/path) +(require (prefix-in db: db)) + +(define db-logger (make-logger 'ebus-db (current-logger))) + +(define db-file? (make-parameter + (build-path (path-only (find-system-path 'run-file)) "database.sqlite3"))) + +(define pool + (db:virtual-connection + (db:connection-pool + (lambda () + (log-message db-logger 'info (format "Open database file ~a" (db-file?)) #t) + (with-handlers ([exn:fail? (lambda (exn) + (log-message db-logger 'error (format "Error opening database ~a" (db-file?)) #t) (raise exn))]) + (db:postgresql-connect #:user "ebus" + #:database "ebus" + #:password "ebus" + #:server "localhost"))) + ;; (db:sqlite3-connect #:database (db-file?)))) + ;; + #:max-connections 5 + #:max-idle-connections 2 + ))) + + +;; Test Database Connection +;; Returns #t on success, #f otherwise +(define (db-test) + (with-handlers ([exn:fail? (lambda (exn) (log-message db-logger 'error (format "Error: ~a" exn) #t) #f)]) + (= (db:query-value pool "SELECT 1") 1))) + +;; Query ID of sensor given by sensor-name +;; Returns null if sensor is undefined +(define (get-sensor-id sensor-name) + (define sql-stmt "SELECT id FROM sensor WHERE name = $1") + (with-handlers ([exn:fail? (lambda (exn) (void))]) + (db:query-value pool sql-stmt sensor-name))) + +;; Create Sensor-ID with given name +;; returns id +(define (create-sensor-id sensor-name) + (log-message db-logger 'info (format "create sensor id for ~a" sensor-name) #t) + (db:query-exec pool "INSERT INTO sensor(name) VALUES ($1)" sensor-name) + (get-sensor-id sensor-name)) + +;; Get ID of sensor given by sensor-name +;; define sensor if needed +(define (get-or-create-sensor-id sensor-name) + (define id (get-sensor-id sensor-name)) + (cond ((void? id) (create-sensor-id sensor-name)) + (else id))) + +;; Insert Field in Database +;; Decide Database-Datatype from Ebus-Datatype +;; then calls 'insert` +(define (db-insert-field sensor-name datatype offset value) + (cond ((member datatype (list "data1c" "data2b" "data2c")) + ;; float + (insert sensor-name value db:sql-null db:sql-null)) + ((member datatype (list "bit" "byte" "data1b" "word" "bcd")) + ;; int + (insert sensor-name db:sql-null value db:sql-null)) + ((member datatype (list "byteEnum")) + ;; string + (insert sensor-name db:sql-null db:sql-null value)) + (else (log-message db-logger 'error (format "Datatype ~a is not support by DB" datatype) #t)))) + +(define (insert sensor-name value-float value-int value-string) + (define sensor-id (get-or-create-sensor-id sensor-name)) + (define type (cond ((not (db:sql-null? value-string)) "string") + ((not (db:sql-null? value-float)) "float") + ((not (db:sql-null? value-int)) "int"))) + (define sql-stmt + (string-append "INSERT INTO value(timestamp, sensor_id, type, value_float, value_int, value_string) " + "VALUES (CURRENT_TIMESTAMP, $1, $2, $3, $4, $5)")) + (log-message db-logger 'info (string-append sql-stmt "\n\t\t" + (format + "sensor-id=~a type=~a value-float=~a value-int=~a value-string=~a" + sensor-id type value-float value-int value-string)) #t) + (db:query-exec pool sql-stmt sensor-id type value-float value-int value-string)) + +(provide + db-file? + db-logger + db-test + db-insert-field) diff --git a/ebus-racket/ebus/layer2.rkt b/ebus-racket/ebus/layer2.rkt new file mode 100644 index 0000000..3dd881c --- /dev/null +++ b/ebus-racket/ebus/layer2.rkt @@ -0,0 +1,104 @@ +#lang racket/base +(require racket/bool + (planet bzlib/parseq:1:3)) + +(define logger (make-logger 'ebus-layer2 (current-logger))) +;; 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) + +(struct ebus-body-mastermaster (crc) #:transparent) + +(struct ebus-body-masterslave + (crc payloadSlaveLength payloadSlave crcSlave) + #:transparent) + +(struct ebus-paket + (source destination primaryCommand secondaryCommand payloadLength payload body) + #:transparent) + +;; single, maybe escaped, payload data byte +(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) bytes ebus-const-syn)))) + any-byte + )) + +(define parse-ebus-broadcast + (token (seq crc <- any-byte + syn <- ebus-const-syn + (return (ebus-body-broadcast crc))))) + +(define parse-ebus-mastermaster + (token (seq crc <- any-byte + 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 <- ebus-const-ackok ;; ACK des Empfängers + payloadSlaveLength <- any-byte + payloadSlave <- (repeat ebus-payload payloadSlaveLength payloadSlaveLength) + crcSlave <- any-byte + 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-paket + (token (seq source <- any-byte + destination <- any-byte + primaryCommand <- any-byte + secondaryCommand <- any-byte + payloadLength <- any-byte + payload <- (repeat ebus-payload payloadLength payloadLength) + body <- (cond ((= destination ebus-const-broadcastaddr) parse-ebus-broadcast) + (else (choice parse-ebus-mastermaster + parse-ebus-masterslave))) + (return (ebus-paket source + destination + primaryCommand + secondaryCommand + payloadLength + payload + body))))) + +(define ebus-sync (tokens syncs <- (seq (repeat (string->bytes/latin-1 "\xaa"))) + (return (length syncs)))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (read-ebus input-port) + (define syn ((make-reader ebus-sync #:sof? #f #:eof? #f) input-port)) + (define paket ((make-reader parse-ebus-paket #:sof? #f #:eof? #f) input-port)) + (cond ((not (false? syn)) + (log-message logger 'debug (format "drop ~s x SYN (~s)" syn ebus-const-syn) #t))) + (cond ((not (false? paket)) + paket) + ((eof-object? (peek-byte input-port)) + eof) + (else + ;; skip one byte + (let ([byte (read-byte input-port)]) + (log-message logger 'debug (format "drop ~s 0x~x ~n" byte byte) #t)) + (read-ebus input-port)))) + +(provide + ;; Read Layer Ebus-Paket `ebus-paket` + (prefix-out layer2- read-ebus) + (prefix-out layer2- (struct-out ebus-paket)) + (prefix-out layer2- (struct-out ebus-body-broadcast)) + (prefix-out layer2- (struct-out ebus-body-mastermaster)) + (prefix-out layer2- (struct-out ebus-body-masterslave)) + (prefix-out layer2- logger)) \ No newline at end of file diff --git a/ebus-racket/ebus/layer7.rkt b/ebus-racket/ebus/layer7.rkt new file mode 100644 index 0000000..3bcad01 --- /dev/null +++ b/ebus-racket/ebus/layer7.rkt @@ -0,0 +1,166 @@ +#lang racket/base +(require racket/list + (planet lizorkin/sxml:2:1/sxml) + (planet lizorkin/ssax:2:0/ssax) + "layer2.rkt") + +(define logger (make-logger 'ebus-layer7 (current-logger))) + +(define definition + (ssax:xml->sxml (open-input-file "../ebus-xml/ebus.xml") + '[(#f . "http://xapek.org/ebus/0.1")])) + +(define (paket ebus-paket) + (define primaryCommand (layer2-ebus-paket-primaryCommand ebus-paket)) + (define secondaryCommand (layer2-ebus-paket-secondaryCommand ebus-paket)) + ((sxpath (string-append "//packet[@primary=" (number->string primaryCommand) + " and @secondary=" (number->string secondaryCommand) "]")) + definition)) + +;; returns the full device-definition +(define (device address) + ((sxpath (string-append "//devices/device[@address=" (number->string address) "]")) + definition)) + +;; returns device-name in a list or empty-list +(define (device-name address) + (first ((sxpath "@name/text()") (device address)))) + + +(define (paket-fields ebus-paket) + (define paket-definition (paket ebus-paket)) + (cond ((> (length paket-definition) 0) + (let* + ([paket-name (string-append + (device-name (layer2-ebus-paket-source ebus-paket)) + "." + (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 (void (log-message logger 'warning (format "Unknown Paket: ~s" ebus-paket) #t))))) + +(define (paket-fields-dispatch-decoder ebus-paket field paket-name) + (define datatype ((sxpath "name()") field)) + (define name (string-append paket-name "." (first ((sxpath "@name/text()") field)))) + (define offset (string->number (first ((sxpath "@offset/text()") field)))) + (define 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 (void (log-message logger 'error (format "unknown datatype: ~a" datatype) #t))))) + +;; type bit +(define (field-decoder-bit value) + (cond ((= value 1) 1) + (else 0))) + +;; type data1b +(define (field-decoder-data1b value) + value) + +;; type data1c +(define (field-decoder-data1c value) + (/ value 2.0)) + +;; type data2b +(define (field-decoder-data2b lowByte highByte) + (if (= (bitwise-and highByte 128) 128) + (* -1 + (+ (+ 256 (bitwise-not highByte)) + (/ (+ 256 (bitwise-not (+ lowByte 1))) 256.0))) + (+ highByte (/ lowByte 256.0)))) + + ;; type data2c + ;; Beispiel für die Berechnung: + ;; if ((x & 8000h) == 8000h) // y negativ + ;; y = - [dez(High_Byte(!x)) 16 + dez(High_Nibble (Low_Byte (!x))) + ;; + (dez(Low_Nibble (Low_Byte (!x))) +1 ) / 16] + ;; else // y positiv + ;; y = dez(High_Byte(x)) 16 + dez(High_ Nibble (Low Byte (x))) + ;; + dez(Low_ Nibble (Low Byte (x))) / 16 +(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 + (+ (arithmetic-shift (u-not highByte) 4) + (highNibble (u-not lowByte)) + (/ (+ (lowNibble (u-not lowByte)) 1) + 16.0))) + (+ (arithmetic-shift highByte 4) + (highNibble lowByte) + (/ + (lowNibble lowByte) + 16)))) + +;; type byteEnum +(define (field-decoder-byteEnum value field-definition) + (define (pred l) + (= value (list-ref l 0))) + (define all-options (for/list ([option ((sxpath "option") field-definition)]) + (list (string->number (first ((sxpath "@value/text()") option))) ;; value, name + (first ((sxpath "@name/text()") option))))) + (define options (filter pred all-options)) + (cond ((= (length options) 1) + (list-ref (first options) 1)) + (else ""))) + +;; 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 # +(define (read-ebus input-port) + (define 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) + ;; read ebus from port an return fields from next paket + (prefix-out layer7- read-ebus) + (prefix-out layer7- logger)) diff --git a/ebus-racket/inserter-pq.rkt b/ebus-racket/inserter-pq.rkt deleted file mode 100755 index 8dc9fb8..0000000 --- a/ebus-racket/inserter-pq.rkt +++ /dev/null @@ -1,121 +0,0 @@ -#! /usr/bin/env racket -#lang racket/base -(require racket/cmdline - racket/tcp - racket/match - "db-pq.rkt" - "layer7.rkt" - "layer2.rkt" - "tcp-repl.rkt") - -(define logger (make-logger 'ebus-inserter (current-logger))) - -(define connect-host? (make-parameter null)) -(define connect-port? (make-parameter null)) -(define loglevel-layer2? (make-parameter 'info)) -(define loglevel-db? (make-parameter 'warning)) -(define insert? (make-parameter #f)) - -(define (get-input-port) - (if (or (null? (connect-host?)) (null? (connect-port?))) - (begin - (log-message (current-logger) 'info "Using stdin" #t) - (current-input-port)) - (let-values ([(cin cout) (tcp-connect (connect-host?) (connect-port?))]) - (log-message logger 'info (format "Connected to ~s ~s" (connect-host?) (connect-port?)) #t) - cin))) - -(define (handle-fields fields) - (for ([field fields]) - (log-message logger 'info (format "Field: ~a" field) #t) - (when (insert?) - (with-handlers ([exn:fail? (lambda (exn) - (log-message logger 'error (format "Failed to insert ~a: ~a" field exn) #t))]) - (apply db-insert-field field))))) - -(define (read-ebus-loop7) - (define input-port (get-input-port)) - - (define (reconnect) - (log-message logger 'warning "Reconnect - sleep 5sec" #t) - (sleep 5) - (log-message logger 'warning "Reconnect - now" #t) - (set! input-port (get-input-port))) - - (let loop () - (with-handlers ([exn:fail:read:eof? - (lambda (exn-eof) - (log-message logger 'error (format "EOF read: ~a" exn) #t) - (raise exn-eof))]; re-raise to prevent reconnect - [exn:fail:network? - (lambda (exn-network) - (log-message logger 'error (format "Network error: ~a" exn) #t) - (reconnect))] - [exn:fail? (lambda (exn) - (log-message logger 'error (format "Failed to parse paket: ~a" exn) #t))]) - (let ([fields (layer7-read-ebus input-port)]) - (when (eof-object? fields) - (raise - (make-exn:fail:read:eof "Read EOF from layer7" - (current-continuation-marks) - (list)))) - (when (not (or (void? fields) (eof-object? fields))) - (handle-fields fields)))) - (loop))) - -;; Start Thread that observe all given log-receivers -(define (start-logger-thread receiver1 . receiverN) - (define receivers (cons receiver1 receiverN)) - (void - (thread - (lambda () - (let loop () - (match (apply sync receivers) - [(vector level msg data) - (printf "[~s] ~a~n" level msg) - (flush-output)]) - (loop)))))) - -;; Marks Namespace where TCP-REPL starts -(define-namespace-anchor repl-ns-anchor) - -(define (main) - ;; Parse commandline - (command-line - #:once-each - [("-c" "--connect") host port "Connect to server " - (connect-host? host) - (connect-port? (string->number port))] - ["--tcp-repl" port "Open REPL on TCP " - (tcp-repl-run (namespace-anchor->namespace repl-ns-anchor) (string->number port))] - ["--debug-layer2" "Log level for Layer 2 Parser" - (loglevel-layer2? 'debug)] - ["--debug-db" "Log level for DB" - (loglevel-db? 'debug)] - ["--insert" "Do Insert into Database" - (insert? #t)] - ["--db-user" user "Datanase User" - (db-con-user? user)] - ["--db-password" password "Database password" - (db-con-password? password)] - ["--db-database" database "Database database-name" - (db-con-database? database)] - ["--db-server" server "Database Address/Server" - (db-con-server? server)]) - - ;; Init Logging - (start-logger-thread (make-log-receiver logger 'info) - (make-log-receiver db-logger (loglevel-db?)) - (make-log-receiver layer2-logger (loglevel-layer2?)) - (make-log-receiver layer7-logger 'info) - (make-log-receiver tcp-repl-logger 'info)) - - ;; Test Database Connection - (when (not (db-pgc-test)) - (log-message logger 'fatal "Failed to connect to database" #t) - (exit 1)) - - ;; Process Ebus Packets - (read-ebus-loop7)) - -(exit (main)) diff --git a/ebus-racket/inserter.rkt b/ebus-racket/inserter.rkt index b07207d..657154f 100755 --- a/ebus-racket/inserter.rkt +++ b/ebus-racket/inserter.rkt @@ -3,10 +3,10 @@ (require racket/cmdline racket/tcp racket/match - "db.rkt" - "layer7.rkt" - "layer2.rkt" - "tcp-repl.rkt") + "ebus/db.rkt" + "ebus/layer7.rkt" + "ebus/layer2.rkt" + "util/tcp-repl.rkt") (define logger (make-logger 'ebus-inserter (current-logger))) @@ -66,14 +66,8 @@ (loglevel-db? 'debug)] ["--insert" "Do Insert into Database" (insert? #t)] - ["--db-user" user "Datanase User" - (db-con-user? user)] - ["--db-password" password "Database password" - (db-con-password? password)] - ["--db-database" database "Database database-name" - (db-con-database? database)] - ["--db-server" server "Database Address/Server" - (db-con-server? server)]) + ["--db-file" user "Database file" + (db-file? user)]) ;; Init Logging (start-logger-thread (make-log-receiver logger 'info) @@ -83,7 +77,7 @@ (make-log-receiver tcp-repl-logger 'info)) ;; Test Database Connection - (when (not (db-pgc-test)) + (when (not (db-test)) (log-message logger 'fatal "Failed to connect to database" #t) (exit 1)) diff --git a/ebus-racket/layer2-test.rkt b/ebus-racket/layer2-test.rkt deleted file mode 100644 index 326725d..0000000 --- a/ebus-racket/layer2-test.rkt +++ /dev/null @@ -1,71 +0,0 @@ -#lang racket/base -(require rackunit - rackunit/text-ui - "layer2.rkt") - -(define layer2-test - (test-suite - "Tests for Ebus Parser" - (test-case - "Test sample Master-Master Paket" - (let - ([paket (layer2-read-ebus - (open-input-bytes - (bytes - 170 ; SYN - 170 - 003 ; Source - 241 ; Destination - 008 ; primaryCommand - 000 ; secondaryCommand - 008 ; payloadLength - 128 ; p1 - 040 ; p2 - 230 ; p3 - 002 ; p4 - 000 ; p5 - 002 ; p6 - 000 ; p7 - 010 ; p8 - 128 ; CRC - 000 ; ACK - 170 ; SYN - 170)))]) - (check-eq? (layer2-ebus-paket-source paket) 003) - (check-eq? (layer2-ebus-paket-destination paket) 241) - (check-eq? (layer2-ebus-paket-primaryCommand paket) 008) - (check-eq? (layer2-ebus-paket-secondaryCommand paket) 000) - (check-eq? (layer2-ebus-paket-payloadLength paket) 008) - (check-eq? (layer2-ebus-paket-payloadLength paket) - (length (layer2-ebus-paket-payload paket))) - )) - (test-case - "test invalid paket" - (let - ([paket (layer2-read-ebus - (open-input-bytes - (bytes - 170 ;SYN - 170 ;SYN - 016 ;SRC - 003 ;DEST - 008 ;PRIM => sollwertuebertragungRegler - 000 ;SEC => sollwertuebertragungRegler - 008 ;PAY - 051 ;P1 - 042 ;P2 - 000 ;P3 - 009 ;P4 - 128 ;P5 - 019 ;P6 - 000 ;P7 | ACK - 045 ;P8 | ??? - 170 ;SYN - 170 ;SYN - )))]) - (check-eq? paket eof) - )) - )) - - -(exit (run-tests layer2-test)) \ No newline at end of file diff --git a/ebus-racket/layer2.rkt b/ebus-racket/layer2.rkt deleted file mode 100644 index 3dd881c..0000000 --- a/ebus-racket/layer2.rkt +++ /dev/null @@ -1,104 +0,0 @@ -#lang racket/base -(require racket/bool - (planet bzlib/parseq:1:3)) - -(define logger (make-logger 'ebus-layer2 (current-logger))) -;; 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) - -(struct ebus-body-mastermaster (crc) #:transparent) - -(struct ebus-body-masterslave - (crc payloadSlaveLength payloadSlave crcSlave) - #:transparent) - -(struct ebus-paket - (source destination primaryCommand secondaryCommand payloadLength payload body) - #:transparent) - -;; single, maybe escaped, payload data byte -(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) bytes ebus-const-syn)))) - any-byte - )) - -(define parse-ebus-broadcast - (token (seq crc <- any-byte - syn <- ebus-const-syn - (return (ebus-body-broadcast crc))))) - -(define parse-ebus-mastermaster - (token (seq crc <- any-byte - 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 <- ebus-const-ackok ;; ACK des Empfängers - payloadSlaveLength <- any-byte - payloadSlave <- (repeat ebus-payload payloadSlaveLength payloadSlaveLength) - crcSlave <- any-byte - 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-paket - (token (seq source <- any-byte - destination <- any-byte - primaryCommand <- any-byte - secondaryCommand <- any-byte - payloadLength <- any-byte - payload <- (repeat ebus-payload payloadLength payloadLength) - body <- (cond ((= destination ebus-const-broadcastaddr) parse-ebus-broadcast) - (else (choice parse-ebus-mastermaster - parse-ebus-masterslave))) - (return (ebus-paket source - destination - primaryCommand - secondaryCommand - payloadLength - payload - body))))) - -(define ebus-sync (tokens syncs <- (seq (repeat (string->bytes/latin-1 "\xaa"))) - (return (length syncs)))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(define (read-ebus input-port) - (define syn ((make-reader ebus-sync #:sof? #f #:eof? #f) input-port)) - (define paket ((make-reader parse-ebus-paket #:sof? #f #:eof? #f) input-port)) - (cond ((not (false? syn)) - (log-message logger 'debug (format "drop ~s x SYN (~s)" syn ebus-const-syn) #t))) - (cond ((not (false? paket)) - paket) - ((eof-object? (peek-byte input-port)) - eof) - (else - ;; skip one byte - (let ([byte (read-byte input-port)]) - (log-message logger 'debug (format "drop ~s 0x~x ~n" byte byte) #t)) - (read-ebus input-port)))) - -(provide - ;; Read Layer Ebus-Paket `ebus-paket` - (prefix-out layer2- read-ebus) - (prefix-out layer2- (struct-out ebus-paket)) - (prefix-out layer2- (struct-out ebus-body-broadcast)) - (prefix-out layer2- (struct-out ebus-body-mastermaster)) - (prefix-out layer2- (struct-out ebus-body-masterslave)) - (prefix-out layer2- logger)) \ No newline at end of file diff --git a/ebus-racket/layer7-test.rkt b/ebus-racket/layer7-test.rkt deleted file mode 100644 index 2099bf8..0000000 --- a/ebus-racket/layer7-test.rkt +++ /dev/null @@ -1,46 +0,0 @@ -#lang racket/base -(require rackunit - rackunit/text-ui - "layer2.rkt" - "layer7.rkt") - -(define layer7-test - (test-suite - "Tests for Ebus Layer 7 Parser" - (test-case - "Test sample Master-Master Paket" - (let* - ([paket (layer2-read-ebus (open-input-bytes (bytes - 170 ; SYN - 170 - 003 ; Source - 241 ; Destination - 008 ; primaryCommand - 000 ; secondaryCommand - 008 ; payloadLength - 128 ; p1 - 040 ; p2 - 230 ; p3 - 002 ; p4 - 200 ; p5 - 002 ; p6 - 000 ; p7 - 010 ; p8 - 128 ; CRC - 000 ; ACK - 170 ; SYN - 170)))] - [fields (layer7-paket-fields paket)]) - (check-true (= 5 (length fields)) "Anzahl der gelesenen Felder") - (for ([field fields]) - (display field) - (display "\n") - (cond ((= (list-ref field 2) 0) (check-equal? (list-ref field 3) 40.5 "Wert TK_soll")) - ((= (list-ref field 2) 2) (check-equal? (list-ref field 3) 2.8984375 "Wert TA_ist")) - ((= (list-ref field 2) 4) (check-equal? (list-ref field 3) 200 "Wert L_zwang")) - ((= (list-ref field 2) 5) (check-equal? (list-ref field 3) 0 "Wert Status")) - ((= (list-ref field 2) 6) (check-equal? (list-ref field 3) 10 "Wert TB_soll")))))) ;end test-case - )) - - -(exit (run-tests layer7-test)) \ No newline at end of file diff --git a/ebus-racket/layer7.rkt b/ebus-racket/layer7.rkt deleted file mode 100644 index b335ddc..0000000 --- a/ebus-racket/layer7.rkt +++ /dev/null @@ -1,158 +0,0 @@ -#lang racket/base -(require racket/list - (planet lizorkin/sxml:2:1/sxml) - (planet lizorkin/ssax:2:0/ssax) - "layer2.rkt") - -(define logger (make-logger 'ebus-layer7 (current-logger))) - -(define definition - (ssax:xml->sxml (open-input-file "../ebus-xml/ebus.xml") - '[(#f . "http://xapek.org/ebus/0.1")])) - -(define (paket ebus-paket) - (define primaryCommand (layer2-ebus-paket-primaryCommand ebus-paket)) - (define secondaryCommand (layer2-ebus-paket-secondaryCommand ebus-paket)) - ((sxpath (string-append "//packet[@primary=" (number->string primaryCommand) - " and @secondary=" (number->string secondaryCommand) "]")) - definition)) - -;; returns the full device-definition -(define (device address) - ((sxpath (string-append "//devices/device[@address=" (number->string address) "]")) - definition)) - -;; returns device-name in a list or empty-list -(define (device-name address) - (first ((sxpath "@name/text()") (device address)))) - - -(define (paket-fields ebus-paket) - (define paket-definition (paket ebus-paket)) - (cond ((> (length paket-definition) 0) - (let* - ([paket-name (string-append - (device-name (layer2-ebus-paket-source ebus-paket)) - "." - (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 (void (log-message logger 'warning (format "Unknown Paket: ~s" ebus-paket) #t))))) - -(define (paket-fields-dispatch-decoder ebus-paket field paket-name) - (define datatype ((sxpath "name()") field)) - (define name (string-append paket-name "." (first ((sxpath "@name/text()") field)))) - (define offset (string->number (first ((sxpath "@offset/text()") field)))) - (define 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 (void (log-message logger 'error (format "unknown datatype: ~a" datatype) #t))))) - -;; type bit -(define (field-decoder-bit value) - (cond ((= value 1) 1) - (else 0))) - -;; type data1b -(define (field-decoder-data1b value) - value) - -;; type data1c -(define (field-decoder-data1c value) - (/ value 2.0)) - -;; type data2b -(define (field-decoder-data2b lowByte highByte) - (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 - (/ - (+ (arithmetic-shift (u-not highByte) 4) - (u-not (highNibble lowByte)) - (+ (u-not (lowNibble lowByte)) 1)) - 16.0)) - (+ (* 16 highByte) - (arithmetic-shift lowByte -4) - (/ (lowNibble lowByte) 16)))) - -;; type byteEnum -(define (field-decoder-byteEnum value field-definition) - (define (pred l) - (= value (list-ref l 0))) - (define all-options (for/list ([option ((sxpath "option") field-definition)]) - (list (string->number (first ((sxpath "@value/text()") option))) ;; value, name - (first ((sxpath "@name/text()") option))))) - (define options (filter pred all-options)) - (cond ((= (length options) 1) - (list-ref (first options) 1)) - (else ""))) - -;; 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 # -(define (read-ebus input-port) - (define 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) - ;; read ebus from port an return fields from next paket - (prefix-out layer7- read-ebus) - (prefix-out layer7- logger)) \ No newline at end of file diff --git a/ebus-racket/tcp-repl.rkt b/ebus-racket/tcp-repl.rkt deleted file mode 100644 index 4b19d85..0000000 --- a/ebus-racket/tcp-repl.rkt +++ /dev/null @@ -1,35 +0,0 @@ -(module tcp-repl racket/base - (require mzlib/thread - racket/tcp) - (provide (prefix-out tcp-repl- run) - (prefix-out tcp-repl- logger)) - - (define logger (make-logger 'tcp-repl (current-logger))) - - (define (run namespace port) - (thread - (lambda () - (run-server port ; TCP-Port - (make-connection-handler namespace) ; connection handler - #f; timeout - (lambda (tcp-port max-allow-wait reuse?) ; listen handler - (log-message logger 'info (format "Listen on ~a:~a" "127.0.0.1" tcp-port) #t) - (tcp-listen tcp-port max-allow-wait reuse? "127.0.0.1")) - )))) - - (define (tcp-tostring port) - (let-values ([(address-from port-from address-to port-to) (tcp-addresses port #t)]) - (format "~a:~a -> ~a:~a" address-from port-from address-to port-to))) - - (define (make-connection-handler namespace) - (lambda (ip op) - (let/ec exit - (log-message logger 'info (format "New Connection ~a" (tcp-tostring ip)) #t) - (parameterize ([current-input-port ip] - [current-output-port op] - [current-error-port op] - [current-namespace namespace]) - (read-eval-print-loop)) - (log-message logger 'info (format "End Connection ~a" (tcp-tostring ip)) #t) - (close-output-port op)))) - ) ; end module tcp-repl \ No newline at end of file diff --git a/ebus-racket/tests/layer2-test.rkt b/ebus-racket/tests/layer2-test.rkt new file mode 100644 index 0000000..c329de1 --- /dev/null +++ b/ebus-racket/tests/layer2-test.rkt @@ -0,0 +1,71 @@ +#lang racket/base +(require rackunit + rackunit/text-ui + "../ebus/layer2.rkt") + +(define layer2-test + (test-suite + "Tests for Ebus Parser" + (test-case + "Test sample Master-Master Paket" + (let + ([paket (layer2-read-ebus + (open-input-bytes + (bytes + 170 ; SYN + 170 + 003 ; Source + 241 ; Destination + 008 ; primaryCommand + 000 ; secondaryCommand + 008 ; payloadLength + 128 ; p1 + 040 ; p2 + 230 ; p3 + 002 ; p4 + 000 ; p5 + 002 ; p6 + 000 ; p7 + 010 ; p8 + 128 ; CRC + 000 ; ACK + 170 ; SYN + 170)))]) + (check-eq? (layer2-ebus-paket-source paket) 003) + (check-eq? (layer2-ebus-paket-destination paket) 241) + (check-eq? (layer2-ebus-paket-primaryCommand paket) 008) + (check-eq? (layer2-ebus-paket-secondaryCommand paket) 000) + (check-eq? (layer2-ebus-paket-payloadLength paket) 008) + (check-eq? (layer2-ebus-paket-payloadLength paket) + (length (layer2-ebus-paket-payload paket))) + )) + (test-case + "test invalid paket" + (let + ([paket (layer2-read-ebus + (open-input-bytes + (bytes + 170 ;SYN + 170 ;SYN + 016 ;SRC + 003 ;DEST + 008 ;PRIM => sollwertuebertragungRegler + 000 ;SEC => sollwertuebertragungRegler + 008 ;PAY + 051 ;P1 + 042 ;P2 + 000 ;P3 + 009 ;P4 + 128 ;P5 + 019 ;P6 + 000 ;P7 | ACK + 045 ;P8 | ??? + 170 ;SYN + 170 ;SYN + )))]) + (check-eq? paket eof) + )) + )) + + +(exit (run-tests layer2-test)) diff --git a/ebus-racket/tests/layer7-test.rkt b/ebus-racket/tests/layer7-test.rkt new file mode 100644 index 0000000..68442d9 --- /dev/null +++ b/ebus-racket/tests/layer7-test.rkt @@ -0,0 +1,46 @@ +#lang racket/base +(require rackunit + rackunit/text-ui + "../ebus/layer2.rkt" + "../ebus/layer7.rkt") + +(define layer7-test + (test-suite + "Tests for Ebus Layer 7 Parser" + (test-case + "Test sample Master-Master Paket" + (let* + ([paket (layer2-read-ebus (open-input-bytes (bytes + 170 ; SYN + 170 + 003 ; Source + 241 ; Destination + 008 ; primaryCommand + 000 ; secondaryCommand + 008 ; payloadLength + 128 ; p1 + 040 ; p2 + 230 ; p3 + 002 ; p4 + 200 ; p5 + 002 ; p6 + 000 ; p7 + 010 ; p8 + 128 ; CRC + 000 ; ACK + 170 ; SYN + 170)))] + [fields (layer7-paket-fields paket)]) + (check-true (= 5 (length fields)) "Anzahl der gelesenen Felder") + (for ([field fields]) + (display field) + (display "\n") + (cond ((= (list-ref field 2) 0) (check-equal? (list-ref field 3) 40.5 "Wert TK_soll")) + ((= (list-ref field 2) 2) (check-equal? (list-ref field 3) 2.8984375 "Wert TA_ist")) + ((= (list-ref field 2) 4) (check-equal? (list-ref field 3) 200 "Wert L_zwang")) + ((= (list-ref field 2) 5) (check-equal? (list-ref field 3) 0 "Wert Status")) + ((= (list-ref field 2) 6) (check-equal? (list-ref field 3) 10 "Wert TB_soll")))))) ;end test-case + )) + + +(exit (run-tests layer7-test)) diff --git a/ebus-racket/util/tcp-repl.rkt b/ebus-racket/util/tcp-repl.rkt new file mode 100644 index 0000000..4b19d85 --- /dev/null +++ b/ebus-racket/util/tcp-repl.rkt @@ -0,0 +1,35 @@ +(module tcp-repl racket/base + (require mzlib/thread + racket/tcp) + (provide (prefix-out tcp-repl- run) + (prefix-out tcp-repl- logger)) + + (define logger (make-logger 'tcp-repl (current-logger))) + + (define (run namespace port) + (thread + (lambda () + (run-server port ; TCP-Port + (make-connection-handler namespace) ; connection handler + #f; timeout + (lambda (tcp-port max-allow-wait reuse?) ; listen handler + (log-message logger 'info (format "Listen on ~a:~a" "127.0.0.1" tcp-port) #t) + (tcp-listen tcp-port max-allow-wait reuse? "127.0.0.1")) + )))) + + (define (tcp-tostring port) + (let-values ([(address-from port-from address-to port-to) (tcp-addresses port #t)]) + (format "~a:~a -> ~a:~a" address-from port-from address-to port-to))) + + (define (make-connection-handler namespace) + (lambda (ip op) + (let/ec exit + (log-message logger 'info (format "New Connection ~a" (tcp-tostring ip)) #t) + (parameterize ([current-input-port ip] + [current-output-port op] + [current-error-port op] + [current-namespace namespace]) + (read-eval-print-loop)) + (log-message logger 'info (format "End Connection ~a" (tcp-tostring ip)) #t) + (close-output-port op)))) + ) ; end module tcp-repl \ No newline at end of file -- cgit v1.2.1