Overview
Comment: | main.db and <run>.db servers working with ulex |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v2.0001 |
Files: | files | file ages | folders |
SHA1: |
2f2d804be032d3ecdb6649b8373c0533 |
User & Date: | matt on 2022-01-03 12:01:45 |
Other Links: | branch diff | manifest | tags |
Context
2022-01-03
| ||
17:38 | wip. rmt:get-keys now works check-in: 3541d27302 user: matt tags: v2.0001 | |
12:01 | main.db and <run>.db servers working with ulex check-in: 2f2d804be0 user: matt tags: v2.0001 | |
09:34 | wip check-in: db564d80d9 user: matt tags: v2.0001 | |
Changes
Modified apimod.scm from [dab49c5a9c] to [97d3b608d8].
︙ | ︙ | |||
372 373 374 375 376 377 378 | ((have-incompletes?) (apply db:have-incompletes? dbstruct params)) ((login) (apply db:login dbstruct params)) ((general-call) (let ((stmtname (car params)) (run-id (cadr params)) (realparams (cddr params))) (db:general-call dbstruct stmtname run-id realparams))) ((sdb-qry) (apply sdb:qry params)) | | | 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 | ((have-incompletes?) (apply db:have-incompletes? dbstruct params)) ((login) (apply db:login dbstruct params)) ((general-call) (let ((stmtname (car params)) (run-id (cadr params)) (realparams (cddr params))) (db:general-call dbstruct stmtname run-id realparams))) ((sdb-qry) (apply sdb:qry params)) ((ping) `(#t ,(current-process-id) ,(cadr params))) ;; (current-process-id)) ((get-changed-record-ids) (apply db:get-changed-record-ids dbstruct params)) ((get-run-record-ids) (apply db:get-run-record-ids dbstruct params)) ;; TESTMETA ((testmeta-get-record) (apply db:testmeta-get-record dbstruct params)) ;; TASKS ((find-task-queue-records) (apply tasks:find-task-queue-records dbstruct params)) |
︙ | ︙ |
Modified megatest.scm from [b00e0e6122] to [7c052417f9].
︙ | ︙ | |||
1065 1066 1067 1068 1069 1070 1071 | sheetname sectionname varname val))) (sqlite3:finalize! db))) (else (pp data)))))) (if out-file (close-output-port out-port)) (exit) ;; yes, bending the rules here - need to exit since this is a utility )) | | > > | | | 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 | sheetname sectionname varname val))) (sqlite3:finalize! db))) (else (pp data)))))) (if out-file (close-output-port out-port)) (exit) ;; yes, bending the rules here - need to exit since this is a utility )) ;; disabled for now #;(if (args:get-arg "-ping") (let* ((server-id (string->number (args:get-arg "-ping"))) ;; extract run-id (i.e. no ":" (host:port (args:get-arg "-ping"))) (server-ready? (or server-id host:port) #f do-exit: #t))) ;;====================================================================== ;; Capture, save and manipulate environments ;;====================================================================== ;; NOTE: Keep these above the section where the server or client code is setup |
︙ | ︙ |
Modified rmtmod.scm from [622fc59774] to [77a44ba5d3].
︙ | ︙ | |||
357 358 359 360 361 362 363 | ;; db is at apath/.db/dbname, rid is an intermediary solution and will be removed ;; sometime in the future ;; (define (rmt:send-receive-real sinfo apath dbname cmd params) (let* ((cdat (rmt:get-conn sinfo apath dbname))) (assert cdat "FATAL: rmt:send-receive-real called without the needed channels opened") (let* ((key #f) | | | | | | 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 | ;; db is at apath/.db/dbname, rid is an intermediary solution and will be removed ;; sometime in the future ;; (define (rmt:send-receive-real sinfo apath dbname cmd params) (let* ((cdat (rmt:get-conn sinfo apath dbname))) (assert cdat "FATAL: rmt:send-receive-real called without the needed channels opened") (let* ((key #f) #;(payload `(,cmd ;; (cmd . ,cmd)(key . ,(conndat-srvkey cdat) ,params)) (uconn (servdat-uconn sinfo)) (res (send-receive uconn (conndat-hostport cdat) cmd params))) ;; payload))) (if (member res '("#<unspecified>")) ;; TODO - fix this in string->sexpr #f res)))) ;; db is at apath/.db/dbname, rid is an intermediary solution and will be removed ;; sometime in the future. ;; |
︙ | ︙ | |||
1612 1613 1614 1615 1616 1617 1618 | ;; called in megatest.scm, host-port is string hostname:port ;; ;; NOTE: This is NOT called directly from clients as not all transports support a client running ;; in the same process as the server. ;; ;; conn is a conndat record ;; | | | 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 | ;; called in megatest.scm, host-port is string hostname:port ;; ;; NOTE: This is NOT called directly from clients as not all transports support a client running ;; in the same process as the server. ;; ;; conn is a conndat record ;; #;(define (server:ping uconn #!key (do-exit #f)) (let* ((srvkey (conndat-srvkey uconn)) (msg (sexpr->string '(ping ,srvkey)))) (send-receive uconn 'ping msg))) ;; (server-ready? host port server-id)) ;;====================================================================== ;; http-transportmod.scm contents moved here ;;====================================================================== |
︙ | ︙ | |||
1645 1646 1647 1648 1649 1650 1651 | (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 qrykey cmd params) ;; | | > > | | 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 | (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 qrykey cmd params) ;; ;;(let* ((prms (alist-ref 'params params))) ;; (api:execute-requests *dbstruct-db* cmd prms))))) (assert (list? params) "FATAL: handler called with non-list 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) |
︙ | ︙ | |||
1789 1790 1791 1792 1793 1794 1795 | 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 | > | | | | 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 | 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 (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 res (car res) res))) ; from the pkts return servers associated with dbpath ;; NOTE: Only one can be alive - have to check on each |
︙ | ︙ |
Modified ulex/ulex.scm from [d58d57adb7] to [5cd5e6659a].
︙ | ︙ | |||
148 149 150 151 152 153 154 | (udat-host-port-set! uconn (conc addr":"port)) (udat-socket-set! uconn tlsn) uconn)) ;; run-listener does all the work of starting a listener in a thread ;; it then returns control ;; | | | 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 | (udat-host-port-set! uconn (conc addr":"port)) (udat-socket-set! uconn tlsn) uconn)) ;; run-listener does all the work of starting a listener in a thread ;; it then returns control ;; (define (run-listener handler-proc #!optional (port-suggestion 4242)) (let* ((uconn (make-udat))) (udat-work-proc-set! uconn handler-proc) (if (setup-listener uconn port-suggestion) (let* ((th1 (make-thread (lambda ()(ulex-cmd-loop uconn)) "Ulex command loop")) (th2 (make-thread (lambda ()(process-work-queue uconn)) "Ulex work queue processor"))) (thread-start! th1) (thread-start! th2) |
︙ | ︙ | |||
233 234 235 236 237 238 239 240 241 242 243 244 245 246 | ;;====================================================================== ;; take a request, rdat, and if not immediate put it in the work queue ;; ;; Reserved cmds; ack ping goodbye response ;; (define (ulex-handler uconn rdat) (match rdat ;; (string-split controldat) ((rem-host-port qrykey cmd params) ;; (print "ulex-handler got: "rem-host-port" qrykey: "qrykey" cmd: "cmd" params: "params) (let ((mbox (hash-table-ref/default (udat-mboxes uconn) qrykey #f))) (case cmd ;; ((ack )(print "Got ack! But why? Should NOT get here.") 'ack) ((ping) | > | 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 | ;;====================================================================== ;; take a request, rdat, and if not immediate put it in the work queue ;; ;; Reserved cmds; ack ping goodbye response ;; (define (ulex-handler uconn rdat) (assert (list? rdat) "FATAL: ulex-handler give rdat as not list") (match rdat ;; (string-split controldat) ((rem-host-port qrykey cmd params) ;; (print "ulex-handler got: "rem-host-port" qrykey: "qrykey" cmd: "cmd" params: "params) (let ((mbox (hash-table-ref/default (udat-mboxes uconn) qrykey #f))) (case cmd ;; ((ack )(print "Got ack! But why? Should NOT get here.") 'ack) ((ping) |
︙ | ︙ |