diff options
Diffstat (limited to 'ebus-racket/ebus')
| -rw-r--r-- | ebus-racket/ebus/db.rkt | 88 | ||||
| -rw-r--r-- | ebus-racket/ebus/layer2.rkt | 104 | ||||
| -rw-r--r-- | ebus-racket/ebus/layer7.rkt | 166 |
3 files changed, 358 insertions, 0 deletions
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 "<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) + (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)) |