Overview
Comment: | Disable handle-exceptions in api and rmt, minor cleanup in dbfile.scm |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.70-refactor-procedures |
Files: | files | file ages | folders |
SHA1: |
633906ee94bda078715733d1aec501ad |
User & Date: | matt on 2022-05-30 20:10:42 |
Other Links: | branch diff | manifest | tags |
Context
2022-05-31
| ||
06:01 | Stop touching log after 600 seconds, clobber *runremote* on client side insteade of setting the remote in the record check-in: a732b9439d user: matt tags: v1.70-refactor-procedures | |
2022-05-30
| ||
20:10 | Disable handle-exceptions in api and rmt, minor cleanup in dbfile.scm check-in: 633906ee94 user: matt tags: v1.70-refactor-procedures | |
2022-05-28
| ||
09:23 | Fixed few things. check-in: 3f484757d1 user: matt tags: v1.70-refactor-procedures | |
Changes
Modified api.scm from [d0f434c57c] to [736048365d].
︙ | ︙ | |||
145 146 147 148 149 150 151 | ;; These are called by the server on recipt of /api calls ;; - keep it simple, only return the actual result of the call, i.e. no meta info here ;; ;; - returns #( flag result ) ;; (define (api:execute-requests dbstruct dat) (db:open-no-sync-db) ;; sets *no-sync-db* | | | | | | | | | 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 | ;; These are called by the server on recipt of /api calls ;; - keep it simple, only return the actual result of the call, i.e. no meta info here ;; ;; - returns #( flag result ) ;; (define (api:execute-requests dbstruct dat) (db:open-no-sync-db) ;; sets *no-sync-db* ;; (handle-exceptions ;; exn ;; (let ((call-chain (get-call-chain))) ;; (debug:print 0 *default-log-port* "WARNING: api:execute-requests received an exception from peer, dat=" dat ", exn=" exn) ;; (print-call-chain (current-error-port)) ;; (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn)) ;; (vector #f (vector exn call-chain dat))) ;; return some stuff for debug if an exception happens (cond ((not (vector? dat)) ;; it is an error to not receive a vector (vector #f (vector #f "remote must be called with a vector"))) ((> *api-process-request-count* 200) ;; 20) (debug:print 0 *default-log-port* "WARNING: api:execute-requests received an overloaded message.") (set! *server-overloaded* #t) (vector #f (vector #f 'overloaded))) ;; the inner vector is what gets returned. nope, don't know why. please refactor! |
︙ | ︙ | |||
373 374 375 376 377 378 379 | payload: `((params . ,params) (ok-res . #t))) (vector #f res)) (begin #;(common:telemetry-log (conc "api-out:"(->string cmd)) payload: `((params . ,params) (ok-res . #f))) | | | 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 | 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))))))) ;; ) ;; http-server send-response ;; api:process-request ;; db:* ;; ;; NB// Runs on the server as part of the server loop ;; |
︙ | ︙ |
Modified dbfile.scm from [c56b4ac76c] to [6257400a66].
︙ | ︙ | |||
670 671 672 673 674 675 676 | (dbfile:print-err "INFO: db:lock-and-delta-sync copying db "runid" at "(current-seconds)) (set! *db-sync-in-progress* #t) (db:sync-touched dbstruct runid keys dbinit) (set! *db-sync-in-progress* #f) (delete-file* lock-file) #t) (begin | | | | | | | | | | | | | | | | | | | | | | | | | 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 | (dbfile:print-err "INFO: db:lock-and-delta-sync copying db "runid" at "(current-seconds)) (set! *db-sync-in-progress* #t) (db:sync-touched dbstruct runid keys dbinit) (set! *db-sync-in-progress* #f) (delete-file* lock-file) #t) (begin (dbfile:print-err "INFO: could not get lock for " from-db-file ", sync likely in progress.") #f )))) ;; ;; Get a lock from the no-sync-db for the from-db, then delta sync the from-db to the to-db, otherwise return #f ;; ;; ;; (define (db:lock-and-delta-sync-orig no-sync-db dbstruct from-db-file runid keys dbinit) ;; (assert (not *db-sync-in-progress*) "FATAL: db:lock-and-sync called while a sync is in progress.") ;; ;; (dbfile:print-err *default-log-port* "db:lock-and-delta-sync") ;; (let* ((lockdat (db:no-sync-get-lock-timeout no-sync-db from-db-file 60)) ;; (gotlock (car lockdat)) ;; (locktime (cdr lockdat))) ;; ;; (debug:print-info 3 *default-log-port* "db:lock-and-delta-sync: got lock?") ;; ;; (if gotlock ;; (begin ;; (dbfile:print-err "INFO: db:lock-and-delta-sync copying db "runid" at "(current-seconds)) ;; (set! *db-sync-in-progress* #t) ;; (db:sync-touched dbstruct runid keys dbinit) ;; (set! *db-sync-in-progress* #f) ;; (db:no-sync-del! no-sync-db from-db-file) ;; #t) ;; (begin ;; (dbfile:print-err "ERROR: could not get lock for " from-db-file " from no-sync-db") ;; #f ;; )))) ;; sync run from tmp disk to nfs disk if touched ;; ;; call with dbinit=db:initialize-main-db ;; (define (db:sync-touched dbstruct run-id keys #!key dbinit (force-sync #f)) (dbfile:print-err "db:sync-touched Syncing: " (conc (if run-id run-id "main") ".db")) |
︙ | ︙ |
Modified rmt.scm from [f6063b275a] to [8bbca69519].
︙ | ︙ | |||
374 375 376 377 378 379 380 | (let* ((qry-is-write (not (member cmd api:read-only-queries))) (db-file-path (db:dbfile-path)) ;; 0)) (dbstructs-local (db:setup #t)) ;; make-dbr:dbstruct path: dbdir local: #t))) (read-only (not (file-write-access? db-file-path))) (start (current-milliseconds)) (resdat (if (not (and read-only qry-is-write)) (let ((v (api:execute-requests dbstructs-local (vector (symbol->string cmd) params)))) | | | | | | | | 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 | (let* ((qry-is-write (not (member cmd api:read-only-queries))) (db-file-path (db:dbfile-path)) ;; 0)) (dbstructs-local (db:setup #t)) ;; make-dbr:dbstruct path: dbdir local: #t))) (read-only (not (file-write-access? db-file-path))) (start (current-milliseconds)) (resdat (if (not (and read-only qry-is-write)) (let ((v (api:execute-requests dbstructs-local (vector (symbol->string cmd) params)))) ;; (handle-exceptions ;; there has been a long history of receiving strange errors from values returned by the client when things go wrong.. ;; exn ;; This is an attempt to detect that situation and recover gracefully ;; (begin ;; (debug:print 0 *default-log-port* "ERROR: bad data from server " v " message: " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn) ;; (vector #t '())) ;; should always get a vector but if something goes wrong return a dummy (if (and (vector? v) (> (vector-length v) 1)) (let ((newvec (vector (vector-ref v 0)(vector-ref v 1)))) newvec) ;; by copying the vector while inside the error handler we should force the detection of a corrupted record (vector #t '()))) ;; ) ;; we could also check that the returned types are valid (vector #t '()))) (success (vector-ref resdat 0)) (res (vector-ref resdat 1)) (duration (- (current-milliseconds) start))) (if (and read-only qry-is-write) (debug:print 0 *default-log-port* "ERROR: attempt to write to read-only database ignored. cmd=" cmd)) (if (not success) |
︙ | ︙ | |||
411 412 413 414 415 416 417 | (mutex-lock! *db-multi-sync-mutex*) / (set! *db-last-access* start-time) ;; THIS IS PROBABLY USELESS? (we are on a client) (mutex-unlock! *db-multi-sync-mutex*))))) res)) (define (rmt:send-receive-no-auto-client-setup connection-info cmd run-id params) (let* ((run-id (if run-id run-id 0)) | | | | | | | | 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 | (mutex-lock! *db-multi-sync-mutex*) / (set! *db-last-access* start-time) ;; THIS IS PROBABLY USELESS? (we are on a client) (mutex-unlock! *db-multi-sync-mutex*))))) res)) (define (rmt:send-receive-no-auto-client-setup connection-info cmd run-id params) (let* ((run-id (if run-id run-id 0)) (res ;; (handle-exceptions ;; exn ;; (begin ;; (print "transport failed. exn=" exn) ;; #f) (http-transport:client-api-send-receive run-id connection-info cmd params))) ;; ) (if (and res (vector-ref res 0)) (vector-ref res 1) ;;; YES!! THIS IS CORRECT!! CHANGE IT HERE, THEN CHANGE rmt:send-receive ALSO!!! #f))) ;;====================================================================== ;; ;; A C T U A L A P I C A L L S |
︙ | ︙ |