Overview
Comment: | Removed qrykey from some calls |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v2.0001-ulex-one-shot |
Files: | files | file ages | folders |
SHA1: |
b40bfb8bf888cd5d6bcb04249214bcfe |
User & Date: | matt on 2022-01-13 22:57:28 |
Other Links: | branch diff | manifest | tags |
Context
2022-01-13
| ||
23:56 | Merged Leaf check-in: caf99578ef user: matt tags: v2.0001-ulex-one-shot | |
22:57 | Removed qrykey from some calls check-in: b40bfb8bf8 user: matt tags: v2.0001-ulex-one-shot | |
06:18 | wip check-in: fb2aca7823 user: matt tags: v2.0001-ulex-one-shot | |
Changes
Modified rmtmod.scm from [1808890632] to [6ed8ab3688].
︙ | |||
405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 | 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 | + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + | ;; ;;====================================================================== ;;====================================================================== ;; 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 ;;====================================================================== (define (rmt:login run-id) (rmt:send-receive 'login run-id (list *toppath* megatest-version *my-signature*))) |
︙ | |||
1477 1478 1479 1480 1481 1482 1483 | 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 | - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | (not (equal? (common:get-last-run-version) (common:version-signature)))) (define (common:api-changed?) (not (equal? (substring (->string megatest-version) 0 4) (substring (conc (common:get-last-run-version)) 0 4)))) |
︙ | |||
1613 1614 1615 1616 1617 1618 1619 | 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 | - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | (if (not hostport) #f (conc "http://" (car hostport) ":" (cadr hostport)))) ;;====================================================================== ;; S E R V E R ;; ====================================================================== |
︙ | |||
1791 1792 1793 1794 1795 1796 1797 | 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 | - - - - - + - - - - | all-pkt-files))) (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 |
︙ | |||
1823 1824 1825 1826 1827 1828 1829 | 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 | + - + | (define (remove-pkts-if-not-alive uconn serv-pkts) (filter (lambda (pkt) (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 (or (equal? host-port (udat-host-port uconn)) ;; might be it is me who is the server |
︙ |
Modified ulex-simple/ulex.scm from [47a35a69e2] to [792a08dc51].
︙ | |||
196 197 198 199 200 201 202 | 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 | - + | ;; retval tells send to expect and wait for return data (one line) and return it or time out ;; this is for ping where we don't want to necessarily have set up our own server yet. ;; ;; NOTE: see below for beginnings of code to allow re-use of tcp connections ;; - I believe (without substantial evidence) that re-using connections will ;; be beneficial ... ;; |
︙ | |||
223 224 225 226 227 228 229 | 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 | - + | (close-output-port oup) (mutex-unlock! *send-mutex*) res))))) ;; send a request to the given host-port and register a mailbox in udata ;; wait for the mailbox data and return it ;; |
︙ | |||
306 307 308 309 310 311 312 313 314 315 316 317 318 319 | 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 | + + | ;; put this following into a do-work procedure (match rdat ((rem-host-port qrykey cmd params) (let* ((start-time (current-milliseconds)) (result (proc rem-host-port qrykey 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)))) ;;====================================================================== ;; misc utils |
︙ |