@@ -28,24 +28,28 @@ ;; (trace ;; rmt:send-receive ;; api:execute-requests ;; ) +;; generate entries for ~/.megatestrc with the following +;; +;; grep define ../rmt.scm | grep rmt: |perl -pi -e 's/\(define\s+\((\S+)\W.*$/\1/'|sort -u + ;;====================================================================== ;; S U P P O R T F U N C T I O N S ;;====================================================================== -;; NOT USED +;; NOT USED? ;; -(define (rmt:call-transport run-id connection-info cmd jparams) - (case (server:get-transport) - ((rpc) ( rpc-transport:client-api-send-receive run-id connection-info cmd jparams)) - ((http) (http-transport:client-api-send-receive run-id connection-info cmd jparams)) - ((fs) ( fs-transport:client-api-send-receive run-id connection-info cmd jparams)) - ((zmq) (zmq-transport:client-api-send-receive run-id connection-info cmd jparams)) - (else ( rpc-transport:client-api-send-receive run-id connection-info cmd jparams)))) +;; (define (rmt:call-transport run-id connection-info cmd jparams) +;; (case (server:get-transport) +;; ((rpc) ( rpc-transport:client-api-send-receive run-id connection-info cmd jparams)) +;; ((http) (http-transport:client-api-send-receive run-id connection-info cmd jparams)) +;; ((fs) ( fs-transport:client-api-send-receive run-id connection-info cmd jparams)) +;; ((zmq) (zmq-transport:client-api-send-receive run-id connection-info cmd jparams)) +;; (else ( rpc-transport:client-api-send-receive run-id connection-info cmd jparams)))) ;; (define (rmt:write-frequency-over-limit? cmd run-id) (and (not (member cmd api:read-only-queries)) (let* ((tmprec (hash-table-ref/default *write-frequency* run-id #f)) @@ -201,33 +205,43 @@ (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) +(define (rmt:open-qry-close-locally cmd run-id params #!key (remretries 5)) (let* ((dbstruct-local (if *dbstruct-db* *dbstruct-db* (let* ((dbdir (conc (configf:lookup *configdat* "setup" "linktree") "/.db")) (db (make-dbr:dbstruct path: dbdir local: #t))) (set! *dbstruct-db* db) db))) - (db-file-path (db:dbfile-path 0))) - ;; (read-only (not (file-read-access? db-file-path))) - (let* ((start (current-milliseconds)) - (resdat (api:execute-requests dbstruct-local (vector (symbol->string cmd) params))) - (res (vector-ref resdat 1)) - (duration (- (current-milliseconds) start))) - (rmt:update-db-stats run-id cmd params duration) - ;; mark this run as dirty if this was a write - (if (not (member cmd api:read-only-queries)) - (let ((start-time (current-seconds))) - (mutex-lock! *db-multi-sync-mutex*) - ;; (if (not (hash-table-ref/default *db-local-sync* run-id #f)) - ;; just set it every time. Is a write more expensive than a read and does it matter? - (hash-table-set! *db-local-sync* (or run-id 0) start-time) ;; the oldest "write" - (mutex-unlock! *db-multi-sync-mutex*))) - res))) + (db-file-path (db:dbfile-path 0)) + ;; (read-only (not (file-read-access? db-file-path))) + (start (current-milliseconds)) + (resdat (api:execute-requests dbstruct-local (vector (symbol->string cmd) params))) + (success (vector-ref resdat 0)) + (res (vector-ref resdat 1)) + (duration (- (current-milliseconds) start))) + (if (not success) + (if (> remretries 0) + (begin + (debug:print 0 "ERROR: local query failed. Trying again.") + (rmt:open-qry-close-locally cmd run-id params remretries: (- remretries 1))) + (begin + (debug:print 0 "ERROR: 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 + (if (not (member cmd api:read-only-queries)) + (let ((start-time (current-seconds))) + (mutex-lock! *db-multi-sync-mutex*) + ;; (if (not (hash-table-ref/default *db-local-sync* run-id #f)) + ;; just set it every time. Is a write more expensive than a read and does it matter? + (hash-table-set! *db-local-sync* (or run-id 0) start-time) ;; the oldest "write" + (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)) ;; (jparams (db:obj->string params)) ;; (rmt:dat->json-str params)) (res (handle-exceptions