Overview
| Comment: | Fixed ping not cleaning up connections |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.80 |
| Files: | files | file ages | folders |
| SHA1: |
48aa93366a26d266c7dbc308e987fb38 |
| User & Date: | matt on 2023-02-01 15:22:36 |
| Other Links: | branch diff | manifest | tags |
Context
|
2023-02-01
| ||
| 20:38 | Convert one statement to prepared, test and do more check-in: 87e172c693 user: matt tags: v1.80 | |
| 15:22 | Fixed ping not cleaning up connections check-in: 48aa93366a user: matt tags: v1.80 | |
| 06:11 | Pulled in ulex from v2.0 check-in: 69eb6e4304 user: matt tags: v1.80 | |
Changes
Modified api.scm from [e629c948c8] to [1fa92fd71b].
| ︙ | ︙ | |||
190 191 192 193 194 195 196 197 198 199 200 201 202 203 |
(readonly-command (member cmd api:read-only-queries))
(writecmd-in-readonly-mode (and readonly-mode (not readonly-command))))
(if (not readonly-command)
(mutex-lock! write-mutex))
(let* ((res
(if writecmd-in-readonly-mode
(conc "attempt to run write command "cmd" on a read-only database")
(case cmd
;;===============================================
;; READ/WRITE QUERIES
;;===============================================
((get-keys-write) (db:get-keys dbstruct)) ;; force a dummy "write" query to force server; for debug in -repl
| > > > > > > > > > > > > > > > > > > > > > > > > > | 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 |
(readonly-command (member cmd api:read-only-queries))
(writecmd-in-readonly-mode (and readonly-mode (not readonly-command))))
(if (not readonly-command)
(mutex-lock! write-mutex))
(let* ((res
(if writecmd-in-readonly-mode
(conc "attempt to run write command "cmd" on a read-only database")
(api:dispatch-request dbstruct cmd run-id params))))
(if (not readonly-command)
(mutex-unlock! write-mutex))
;; save all stats
(let ((delta-t (- (current-milliseconds)
start-t))
(modified-cmd (if (eq? cmd 'general-call)
(string->symbol (conc "general-call-" (car params)))
cmd)))
(hash-table-set! *db-api-call-time* modified-cmd
(cons delta-t (hash-table-ref/default *db-api-call-time* modified-cmd '()))))
(if writecmd-in-readonly-mode
(begin
#;(common:telemetry-log (conc "api-out:"(->string cmd))
payload: `((params . ,params)
(ok-res . #t)))
(vector #f res))
(begin
#;(common:telemetry-log (conc "api-out:"(->string cmd))
payload: `((params . ,params)
(ok-res . #f)))
(vector #t res))))))))
(define (api:dispatch-request dbstruct cmd run-id params)
(case cmd
;;===============================================
;; READ/WRITE QUERIES
;;===============================================
((get-keys-write) (db:get-keys dbstruct)) ;; force a dummy "write" query to force server; for debug in -repl
|
| ︙ | ︙ | |||
368 369 370 371 372 373 374 |
;; TESTMETA
((testmeta-get-record) (apply db:testmeta-get-record dbstruct params))
;; TASKS
((find-task-queue-records) (apply tasks:find-task-queue-records dbstruct params))
(else
(debug:print 0 *default-log-port* "ERROR: bad api call " cmd)
| | < < < < < < < < < < < < < < < < < < < < < < | 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 |
;; TESTMETA
((testmeta-get-record) (apply db:testmeta-get-record dbstruct params))
;; TASKS
((find-task-queue-records) (apply tasks:find-task-queue-records dbstruct params))
(else
(debug:print 0 *default-log-port* "ERROR: bad api call " cmd)
(conc "ERROR: BAD api call " cmd))))
;; http-server send-response
;; api:process-request
;; db:*
;;
;; NB// Runs on the server as part of the server loop
;;
|
| ︙ | ︙ |
Modified server.scm from [1a43f0a48b] to [1c00c07593].
| ︙ | ︙ | |||
679 680 681 682 683 684 685 686 687 688 689 690 691 692 |
((and (list? host-port)
(eq? (length host-port) 2))
(let* ((myrunremote (make-remote))
(iface (car host-port))
(port (cadr host-port))
(server-dat (client:connect iface port server-id myrunremote))
(login-res (rmt:login-no-auto-client-setup myrunremote)))
(if (and (list? login-res)
(car login-res))
(begin
;; (print "LOGIN_OK")
(if do-exit (exit 0))
#t)
(begin
| > | 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 |
((and (list? host-port)
(eq? (length host-port) 2))
(let* ((myrunremote (make-remote))
(iface (car host-port))
(port (cadr host-port))
(server-dat (client:connect iface port server-id myrunremote))
(login-res (rmt:login-no-auto-client-setup myrunremote)))
(http-transport:close-connections myrunremote)
(if (and (list? login-res)
(car login-res))
(begin
;; (print "LOGIN_OK")
(if do-exit (exit 0))
#t)
(begin
|
| ︙ | ︙ |