@@ -23,10 +23,11 @@ (declare (uses commonmod)) (declare (uses dbfile)) ;; needed for records (declare (uses dbmod)) (declare (uses mtmod)) (declare (uses tcp-transportmod)) +(declare (uses apimod)) (module rmtmod * (import scheme chicken data-structures extras matchable srfi-1 srfi-69) @@ -34,10 +35,11 @@ (import commonmod tcp-transportmod dbfile dbmod debugprint + apimod mtmod) (include "db_records.scm") (defstruct alldat @@ -370,52 +372,52 @@ (cons 'none 0)) (loop (car tal)(cdr tal) newmax-cmd currmax))))))) (mutex-unlock! *db-stats-mutex*) res)) -(define (rmt:open-qry-close-locally cmd run-id params #!key (remretries 5)) - (let* ((qry-is-write (not (member cmd api:read-only-queries))) - (db-file-path (common:make-tmpdir-name *toppath* "")) ;; 0)) - (dbstructs-local (db:setup)) - (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) - (if (> remretries 0) - (begin - (debug:print-error 0 *default-log-port* "local query failed. Trying again.") - (thread-sleep! (/ (random 5000) 1000)) ;; some random delay - (rmt:open-qry-close-locally cmd run-id params remretries: (- remretries 1))) - (begin - (debug:print-error 0 *default-log-port* "too many retries in rmt:open-qry-close-locally, giving up") - #f)) - (begin - ;; (rmt:update-db-stats run-id cmd params duration) - ;; mark this run as dirty if this was a write, the watchdog is responsible for syncing it - (if qry-is-write - (let ((start-time (current-seconds))) - (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)) +;; =not-used= (define (rmt:open-qry-close-locally cmd run-id params #!key (remretries 5)) +;; =not-used= (let* ((qry-is-write (not (member cmd api:read-only-queries))) +;; =not-used= (db-file-path (common:make-tmpdir-name *toppath* "")) ;; 0)) +;; =not-used= (dbstructs-local (db:setup)) +;; =not-used= (read-only (not (file-write-access? db-file-path))) +;; =not-used= (start (current-milliseconds)) +;; =not-used= (resdat (if (not (and read-only qry-is-write)) +;; =not-used= (let ((v (api:execute-requests dbstructs-local (vector (symbol->string cmd) params)))) +;; =not-used= ;; (handle-exceptions ;; there has been a long history of receiving strange errors from values returned by the client when things go wrong.. +;; =not-used= ;; exn ;; This is an attempt to detect that situation and recover gracefully +;; =not-used= ;; (begin +;; =not-used= ;; (debug:print 0 *default-log-port* "ERROR: bad data from server " v " message: " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn) +;; =not-used= ;; (vector #t '())) ;; should always get a vector but if something goes wrong return a dummy +;; =not-used= (if (and (vector? v) +;; =not-used= (> (vector-length v) 1)) +;; =not-used= (let ((newvec (vector (vector-ref v 0)(vector-ref v 1)))) +;; =not-used= newvec) ;; by copying the vector while inside the error handler we should force the detection of a corrupted record +;; =not-used= (vector #t '()))) ;; ) ;; we could also check that the returned types are valid +;; =not-used= (vector #t '()))) +;; =not-used= (success (vector-ref resdat 0)) +;; =not-used= (res (vector-ref resdat 1)) +;; =not-used= (duration (- (current-milliseconds) start))) +;; =not-used= (if (and read-only qry-is-write) +;; =not-used= (debug:print 0 *default-log-port* "ERROR: attempt to write to read-only database ignored. cmd=" cmd)) +;; =not-used= (if (not success) +;; =not-used= (if (> remretries 0) +;; =not-used= (begin +;; =not-used= (debug:print-error 0 *default-log-port* "local query failed. Trying again.") +;; =not-used= (thread-sleep! (/ (random 5000) 1000)) ;; some random delay +;; =not-used= (rmt:open-qry-close-locally cmd run-id params remretries: (- remretries 1))) +;; =not-used= (begin +;; =not-used= (debug:print-error 0 *default-log-port* "too many retries in rmt:open-qry-close-locally, giving up") +;; =not-used= #f)) +;; =not-used= (begin +;; =not-used= ;; (rmt:update-db-stats run-id cmd params duration) +;; =not-used= ;; mark this run as dirty if this was a write, the watchdog is responsible for syncing it +;; =not-used= (if qry-is-write +;; =not-used= (let ((start-time (current-seconds))) +;; =not-used= (mutex-lock! *db-multi-sync-mutex*) +;; =not-used= (set! *db-last-access* start-time) ;; THIS IS PROBABLY USELESS? (we are on a client) +;; =not-used= (mutex-unlock! *db-multi-sync-mutex*))))) +;; =not-used= res)) ;;====================================================================== ;; ;; A C T U A L A P I C A L L S ;;