@@ -7,12 +7,12 @@ ;; This program is distributed WITHOUT ANY WARRANTY; without even the ;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ;; PURPOSE. ;;====================================================================== -(use sqlite3 srfi-1 posix regex-case base64 format dot-locking csv-xml z3) -(require-extension sqlite3 regex posix) +(use srfi-1 posix regex-case base64 format dot-locking csv-xml z3 nanomsg sql-de-lite hostinfo) +(require-extension regex posix) (require-extension (srfi 18) extras tcp rpc) (import (prefix sqlite3 sqlite3:)) (import (prefix base64 base64:)) @@ -313,11 +313,11 @@ (set-signal-handler! signal/int std-signal-handler) ;; ^C (set-signal-handler! signal/term std-signal-handler) (set-signal-handler! signal/stop std-signal-handler) ;; ^Z ;;====================================================================== -;; Misc utils +;; M I S C U T I L S ;;====================================================================== ;; Convert strings like "5s 2h 3m" => 60x60x2 + 3x60 + 5 (define (common:hms-string->seconds tstr) (let ((parts (string-split tstr)) @@ -751,5 +751,82 @@ ((equal? status "KILLED") "orange") ((equal? status "KILLREQ") "purple") ((equal? status "RUNNING") "blue") ((equal? status "ABORT") "brown") (else "black"))) + +;;====================================================================== +;; N A N O M S G C L I E N T +;;====================================================================== + +(define (server:get-best-guess-address hostname) + (let ((res #f)) + (for-each + (lambda (adr) + (if (not (eq? (u8vector-ref adr 0) 127)) + (set! res adr))) + ;; NOTE: This can fail when there is no mention of the host in /etc/hosts. FIXME + (vector->list (hostinfo-addresses (hostname->hostinfo hostname)))) + (string-intersperse + (map number->string + (u8vector->list + (if res res (hostname->ip hostname)))) "."))) + +(define (common:send-dboard-main-changed) + (let ((dashboard-ips (mddb:get-dashboards))) + #f)) + + +;;====================================================================== +;; D A S H B O A R D D B +;;====================================================================== + +(define (mddb:open-db) + (let* ((db (open-database (conc (get-environment-variable "HOME") "/.dashboard.db")))) + (set-busy-handler! db (busy-timeout 10000)) + (for-each + (lambda (qry) + (exec (sql db qry))) + (list + "CREATE TABLE IF NOT EXISTS vars (id INTEGER PRIMARY KEY,key TEXT, val TEXT, CONSTRAINT varsconstraint UNIQUE (key));" + "CREATE TABLE IF NOT EXISTS dashboards ( + id INTEGER PRIMARY KEY, + pid INTEGER, + username TEXT, + hostname TEXT, + ipaddr TEXT, + portnum INTEGER, + start_time TIMESTAMP DEFAULT (strftime('%s','now')), + CONSTRAINT hostport UNIQUE (hostname,portnum) + );" + )) + db)) + +;; register a dashboard +;; +(define (mddb:register-dashboard port) + (let* ((pid (current-process-id)) + (hostname (get-host-name)) + (ipaddr (server:get-best-guess-address hostname)) + (username (current-user-name)) ;; (car userinfo))) + (db (mddb:open-db))) + (print "Register monitor, pid: " pid ", hostname: " hostname ", port: " port ", username: " username) + (exec (sql db "INSERT OR REPLACE INTO dashboards (pid,username,hostname,ipaddr,portnum) VALUES (?,?,?,?,?);") + pid username hostname ipaddr port) + (close-database db))) + +;; unregister a monitor +;; +(define (mddb:unregister-dashboard host port) + (let* ((db (mddb:open-db))) + (print "Register unregister monitor, host:port=" host ":" port) + (exec (sql db "DELETE FROM dashboards WHERE hostname=? AND portnum=?;") host port) + (close-database db))) + +;; get registered dashboards +;; +(define (mddb:get-dashboards) + (let ((db (mddb:open-db))) + (query fetch-column + (sql db "SELECT ipaddr || ':' || portnum FROM dashboards;")))) + +