Index: rmtmod.scm ================================================================== --- rmtmod.scm +++ rmtmod.scm @@ -407,18 +407,127 @@ ;;====================================================================== ;; S E R V E R ;;====================================================================== + +(define (http-get-function fnkey) + (hash-table-ref/default *http-functions* fnkey (lambda () "nothing here yet"))) + +(define *rmt:run-mutex* (make-mutex)) +(define *rmt:run-flag* #f) + +;; Main entry point to start a server. was start-server +(define (rmt:run hostn) + (assert (args:get-arg "-server") "FATAL: rmt:run called on non-server process") + (mutex-lock! *rmt:run-mutex*) + (if *rmt:run-flag* + (begin + (debug:print-warn 0 *default-log-port* "rmt:run already running.") + (mutex-unlock! *rmt:run-mutex*)) + (begin + (set! *rmt:run-flag* #t) + (mutex-unlock! *rmt:run-mutex*) + ;; ;; Configurations for server + ;; (tcp-buffer-size 2048) + ;; (max-connections 2048) + (debug:print 0 *default-log-port* "PID: "(current-process-id)". Attempting to start server ...") + (if (and *db-serv-info* + (servdat-port *db-serv-info*)) + (let* ((uconn (servdat-uconn *db-serv-info*))) + (wait-and-close uconn)) + (let* ((port (portlogger:open-run-close portlogger:find-port)) + (handler-proc (lambda (rem-host-port qrykey cmd params) ;; + (set! *db-last-access* (current-seconds)) + (assert (list? params) "FATAL: handler called with non-list params") + (assert (args:get-arg "-server") "FATAL: handler called on non-server side. cmd="cmd", params="params) + (debug:print 0 *default-log-port* "handler call: "cmd", params="params) + (api:execute-requests *dbstruct-db* cmd params)))) + ;; (api:process-request *dbstuct-db* + (if (not *db-serv-info*) + (set! *db-serv-info* (make-servdat host: hostn port: port))) + (let* ((uconn (run-listener handler-proc port)) + (rport (udat-port uconn))) ;; the real port + (servdat-host-set! *db-serv-info* hostn) + (servdat-port-set! *db-serv-info* rport) + (servdat-uconn-set! *db-serv-info* uconn) + (wait-and-close uconn) + (db:print-current-query-stats) + ))) + (let* ((host (servdat-host *db-serv-info*)) + (port (servdat-port *db-serv-info*)) + (mode (or (servdat-mode *db-serv-info*) + "non-db"))) + ;; server exit stuff here + ;; (rmt:server-shutdown host port) - always do in on-exit + ;; (portlogger:open-run-close portlogger:set-port port "released") ;; moved to on-exit + (debug:print-info 0 *default-log-port* "Server "host":"port" mode "mode"shutdown complete. Exiting") + )))) + +;;====================================================================== +;; S E R V E R U T I L I T I E S +;;====================================================================== + +;; host and port are used to ensure we are remove proper records +(define (rmt:server-shutdown host port) + (let ((dbfile (servdat-dbfile *db-serv-info*))) + (debug:print-info 0 *default-log-port* "dbfile is "dbfile) + (if dbfile + (let* ((am-server (args:get-arg "-server")) + (dbfile (args:get-arg "-db")) + (apath *toppath*) + #;(sinfo *remotedat*)) ;; foundation for future fix + (if *dbstruct-db* + (let* ((dbdat (db:get-dbdat *dbstruct-db* apath dbfile)) + (db (dbr:dbdat-db dbdat)) + (inmem (dbr:dbdat-db dbdat)) ;; WRONG + ) + ;; do a final sync here + (debug:print-info 0 *default-log-port* "Doing final sync for "apath" "dbfile" at "(current-seconds)) + (db:sync-inmem->disk *dbstruct-db* apath dbfile force-sync: #t) + ;; let's finalize here + (debug:print-info 0 *default-log-port* "Finalizing db and inmem") + (if (sqlite3:database? db) + (sqlite3:finalize! db) + (debug:print-info 0 *default-log-port* "in rmt:server-shutdown, db is not a database, not finalizing...")) + (if (sqlite3:database? inmem) + (sqlite3:finalize! inmem) + (debug:print-info 0 *default-log-port* "in rmt:server-shutdown, inmem is not a database, not finalizing...")) + (debug:print-info 0 *default-log-port* "Finalizing db and inmem complete")) + (debug:print-info 0 *default-log-port* "Db was never opened, no cleanup to do.")) + (if (not am-server) + (debug:print-info 0 *default-log-port* "I am not a server, should NOT get here!") + (if (string-match ".*/main.db$" dbfile) + (let ((pkt-file (conc (get-pkts-dir *toppath*) + "/" (servdat-uuid *db-serv-info*) + ".pkt"))) + (debug:print-info 0 *default-log-port* "removing pkt "pkt-file) + (delete-file* pkt-file) + (debug:print-info 0 *default-log-port* "Releasing lock (if any) for "dbfile ", host "host", port "port) + (db:with-lock-db + (servdat-dbfile *db-serv-info*) + (lambda (dbh dbfile) + (db:release-lock dbh dbfile host port)))) ;; I'm not the server - should not have a lock to remove + (let* ((sdat *db-serv-info*) ;; we have a run-id server + (host (servdat-host sdat)) + (port (servdat-port sdat)) + (uuid (servdat-uuid sdat)) + (res (rmt:deregister-server *db-serv-info* *toppath* host port uuid dbfile))) + (debug:print-info 0 *default-log-port* "deregistered-server, res="res) + (debug:print-info 0 *default-log-port* "deregistering server "host":"port" with uuid "uuid) + ))))))) + (define (rmt:kill-server run-id) (rmt:send-receive 'kill-server #f (list run-id))) (define (rmt:start-server run-id) (rmt:send-receive 'start-server #f (list run-id))) (define (rmt:server-info apath dbname) (rmt:send-receive 'get-server-info #f (list apath dbname))) + + ;;====================================================================== ;; M I S C ;;====================================================================== @@ -1479,59 +1588,10 @@ (define (common:api-changed?) (not (equal? (substring (->string megatest-version) 0 4) (substring (conc (common:get-last-run-version)) 0 4)))) -;; host and port are used to ensure we are remove proper records -(define (rmt:server-shutdown host port) - (let ((dbfile (servdat-dbfile *db-serv-info*))) - (debug:print-info 0 *default-log-port* "dbfile is "dbfile) - (if dbfile - (let* ((am-server (args:get-arg "-server")) - (dbfile (args:get-arg "-db")) - (apath *toppath*) - #;(sinfo *remotedat*)) ;; foundation for future fix - (if *dbstruct-db* - (let* ((dbdat (db:get-dbdat *dbstruct-db* apath dbfile)) - (db (dbr:dbdat-db dbdat)) - (inmem (dbr:dbdat-db dbdat)) ;; WRONG - ) - ;; do a final sync here - (debug:print-info 0 *default-log-port* "Doing final sync for "apath" "dbfile" at "(current-seconds)) - (db:sync-inmem->disk *dbstruct-db* apath dbfile force-sync: #t) - ;; let's finalize here - (debug:print-info 0 *default-log-port* "Finalizing db and inmem") - (if (sqlite3:database? db) - (sqlite3:finalize! db) - (debug:print-info 0 *default-log-port* "in rmt:server-shutdown, db is not a database, not finalizing...")) - (if (sqlite3:database? inmem) - (sqlite3:finalize! inmem) - (debug:print-info 0 *default-log-port* "in rmt:server-shutdown, inmem is not a database, not finalizing...")) - (debug:print-info 0 *default-log-port* "Finalizing db and inmem complete")) - (debug:print-info 0 *default-log-port* "Db was never opened, no cleanup to do.")) - (if (not am-server) - (debug:print-info 0 *default-log-port* "I am not a server, should NOT get here!") - (if (string-match ".*/main.db$" dbfile) - (let ((pkt-file (conc (get-pkts-dir *toppath*) - "/" (servdat-uuid *db-serv-info*) - ".pkt"))) - (debug:print-info 0 *default-log-port* "removing pkt "pkt-file) - (delete-file* pkt-file) - (debug:print-info 0 *default-log-port* "Releasing lock (if any) for "dbfile ", host "host", port "port) - (db:with-lock-db - (servdat-dbfile *db-serv-info*) - (lambda (dbh dbfile) - (db:release-lock dbh dbfile host port)))) ;; I'm not the server - should not have a lock to remove - (let* ((sdat *db-serv-info*) ;; we have a run-id server - (host (servdat-host sdat)) - (port (servdat-port sdat)) - (uuid (servdat-uuid sdat)) - (res (rmt:deregister-server *db-serv-info* *toppath* host port uuid dbfile))) - (debug:print-info 0 *default-log-port* "deregistered-server, res="res) - (debug:print-info 0 *default-log-port* "deregistering server "host":"port" with uuid "uuid) - ))))))) - (define (std-exit-procedure) ;;(common:telemetry-log-close) (on-exit (lambda () 0)) ;;(debug:print-info 13 *default-log-port* "std-exit-procedure called; *time-to-exit*="*time-to-exit*) (let ((no-hurry (if (bdat-time-to-exit *bdat*) ;; hurry up @@ -1615,68 +1675,10 @@ (conc "http://" (car hostport) ":" (cadr hostport)))) ;;====================================================================== ;; S E R V E R ;; ====================================================================== - -(define (http-get-function fnkey) - (hash-table-ref/default *http-functions* fnkey (lambda () "nothing here yet"))) - -(define *rmt:run-mutex* (make-mutex)) -(define *rmt:run-flag* #f) - -;; Main entry point to start a server. was start-server -(define (rmt:run hostn) - (assert (args:get-arg "-server") "FATAL: rmt:run called on non-server process") - (mutex-lock! *rmt:run-mutex*) - (if *rmt:run-flag* - (begin - (debug:print-warn 0 *default-log-port* "rmt:run already running.") - (mutex-unlock! *rmt:run-mutex*)) - (begin - (set! *rmt:run-flag* #t) - (mutex-unlock! *rmt:run-mutex*) - ;; ;; Configurations for server - ;; (tcp-buffer-size 2048) - ;; (max-connections 2048) - (debug:print 2 *default-log-port* "PID: "(current-process-id)". Attempting to start the server ...") - (if (and *db-serv-info* - (servdat-uconn *db-serv-info*)) - (let* ((uconn (servdat-uconn *db-serv-info*))) - (wait-and-close uconn)) - (let* ((port (portlogger:open-run-close portlogger:find-port)) - (handler-proc (lambda (rem-host-port cmd params) ;; - (set! *db-last-access* (current-seconds)) - (assert (list? params) "FATAL: handler called with non-list params") - (assert (args:get-arg "-server") "FATAL: handler called on non-server side. cmd="cmd", params="params) - (debug:print 0 *default-log-port* "handler call: "cmd", params="params) - (api:execute-requests *dbstruct-db* cmd params)))) - ;; (api:process-request *dbstuct-db* - (if (not *db-serv-info*) - (set! *db-serv-info* (make-servdat host: hostn port: port))) - (let* ((uconn (run-listener handler-proc port)) - (rport (udat-port uconn))) ;; the real port - (servdat-host-set! *db-serv-info* hostn) - (servdat-port-set! *db-serv-info* rport) - (servdat-uconn-set! *db-serv-info* uconn) - (wait-and-close uconn) - (db:print-current-query-stats) - ))) - (let* ((host (servdat-host *db-serv-info*)) - (port (servdat-port *db-serv-info*)) - (mode (or (servdat-mode *db-serv-info*) - "non-db"))) - ;; server exit stuff here - ;; (rmt:server-shutdown host port) - always do in on-exit - ;; (portlogger:open-run-close portlogger:set-port port "released") ;; moved to on-exit - (debug:print-info 0 *default-log-port* "Server "host":"port" mode "mode"shutdown complete. Exiting") - )))) - -;;====================================================================== -;; S E R V E R U T I L I T I E S -;;====================================================================== - ;;====================================================================== ;; C L I E N T S ;;====================================================================== (define (rmt:get-time-to-cleanup) @@ -1793,19 +1795,11 @@ (define (server-address srv-pkt) (conc (alist-ref 'host srv-pkt) ":" (alist-ref 'port srv-pkt))) (define (server-ready? uconn host-port key) ;; server-address is host:port - (let* ((params `((cmd . ping)(key . ,key))) - (data `((cmd . ping) - (key . ,key) - (params . ,params))) ;; I don't get it. - (res (send-receive uconn host-port 'ping data))) - (if (eq? res 'ack) ;; yep, likely it is who we want on the other end - res - #f))) -;; (begin (debug:print-info 0 *default-log-port* "server-ready? => "res) #f)))) + (send-receive uconn host-port 'ping '())) ; from the pkts return servers associated with dbpath ;; NOTE: Only one can be alive - have to check on each ;; in the list of pkts returned ;; @@ -1825,11 +1819,12 @@ (let* ((host (alist-ref 'host pkt)) (port (alist-ref 'port pkt)) (host-port (conc host":"port)) (key (alist-ref 'servkey pkt)) (pktz (alist-ref 'Z pkt)) - (res (server-ready? uconn host-port key))) + (res (or (equal? host-port (udat-host-port uconn)) ;; might be it is me who is the server + (server-ready? uconn host-port key)))) (if res res (let* ((pktsdir (get-pkts-dir *toppath*)) (pktpath (conc pktsdir"/"pktz".pkt"))) (debug:print 0 *default-log-port* "WARNING: pkt with no server "pktpath) Index: ulex-simple/ulex.scm ================================================================== --- ulex-simple/ulex.scm +++ ulex-simple/ulex.scm @@ -286,10 +286,12 @@ ((rem-host-port cmd params) (let* ((start-time (current-milliseconds)) (result (proc rem-host-port cmd params)) (end-time (current-milliseconds)) (run-time (- end-time start-time))) + (if (> run-time 1000) + (print "ULEX INFO: Note that "cmd" with params "params" took "run-time"ms to complete.")) result)) (else (print "ERROR: rdat "rdat", did not match rem-host-port qrykey cmd params") #f))))