Overview
| Comment: | Lazy server starting mostly working well |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.60 |
| Files: | files | file ages | folders |
| SHA1: |
abf327cf9488b3ff4c7ccdd6640e02e6 |
| User & Date: | matt on 2014-10-05 23:51:41 |
| Other Links: | branch diff | manifest | tags |
Context
|
2014-10-06
| ||
| 00:05 | Keep servers alive only if have RUNNING or REMOTEHOSTSTART tests check-in: e2b136c3de user: matt tags: v1.60 | |
|
2014-10-05
| ||
| 23:51 | Lazy server starting mostly working well check-in: abf327cf94 user: matt tags: v1.60 | |
| 22:47 | missed these changes ... check-in: 376151225a user: matt tags: v1.60 | |
Changes
Modified rmt.scm from [16ddcd4743] to [4cb886426c].
| ︙ | ︙ | |||
33 34 35 36 37 38 39 | ;;====================================================================== ;; S U P P O R T F U N C T I O N S ;;====================================================================== ;; #t means - please start a server! ;; (define (rmt:write-frequency-over-limit? cmd run-id) | | | | | | | | | > > | | < < | | | | | < < < > | 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 |
;;======================================================================
;; S U P P O R T F U N C T I O N S
;;======================================================================
;; #t means - please start a server!
;;
(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))
(record (if tmprec tmprec
(let ((v (vector (current-seconds) 0)))
(hash-table-set! *write-frequency* run-id v)
v)))
(count (+ 1 (vector-ref record 1)))
(start (vector-ref record 0))
(queries-per-second (/ (* count 1.0)
(max (- (current-seconds) start) 1))))
(vector-set! record 1 count)
(if (and (> count 10)
(> queries-per-second 10))
(begin
(debug:print-info 1 "db write rate too high, starting a server, count=" count " start=" start " run-id=" run-id " queries-per-second=" queries-per-second)
#t)
#f))))
;; cmd is a symbol
;; vars is a json string encoding the parameters for the call
;;
(define (rmt:send-receive cmd rid params)
(let* ((run-id (if rid rid 0))
(connection-info (let ((cinfo (hash-table-ref/default *runremote* run-id #f)))
(if cinfo
cinfo
;; NB// can cache the answer for server running for 10 seconds ...
;; ;; (and (not (rmt:write-frequency-over-limit? cmd run-id))
(if (open-run-close tasks:server-running-or-starting? tasks:open-db run-id)
(let ((res (client:setup run-id)))
(if res
(hash-table-ref/default *runremote* run-id #f) ;; client:setup filled this in (hopefully)
#f))
#f))))
(jparams (db:obj->string params)))
(if connection-info
(let ((res (http-transport:client-api-send-receive run-id connection-info cmd jparams)))
(if res
(db:string->obj res)
(let ((new-connection-info (client:setup run-id)))
(debug:print 0 "WARNING: Communication failed, trying call to http-transport:client-api-send-receive again.")
(rmt:send-receive cmd run-id params))))
(begin
(debug:print-info 4 "no server and read-only query, bypassing normal channel")
(if (rmt:write-frequency-over-limit? cmd run-id)(server:kind-run run-id))
(rmt:open-qry-close-locally cmd run-id params)))))
(define (rmt:open-qry-close-locally cmd run-id params)
(let* ((dbdir (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
(dbstruct-local (if *dbstruct-db*
*dbstruct-db*
(let ((db (make-dbr:dbstruct path: dbdir local: #t)))
|
| ︙ | ︙ |