30
31
32
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
|
;; )
;;======================================================================
;; S U P P O R T F U N C T I O N S
;;======================================================================
(define (rmt:write-frequency-over-limit? cmd run-id)
(or (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)))
(vector-set! record 1 count)
(if (and (> count 10)
(< (/ (- (current-seconds) start)
count) ;; seconds per count
10))
(begin
(debug:print-info 1 "db write rate too high, starting a server")
#t)
#f)))) ;; less than 10 seconds per count - start up a server
;; cmd is a symbol
;; vars is a json string encoding the parameters for the call
;;
(define (rmt:send-receive cmd rid params)
|
>
>
|
|
|
30
31
32
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
|
;; )
;;======================================================================
;; 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)
(or (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)))
(vector-set! record 1 count)
(if (and (> count 10)
(< (/ (- (current-seconds) start)
count) ;; seconds per count
10))
(begin
(debug:print-info 1 "db write rate too high, starting a server, count=" count " start=" start " run-id=" run-id)
#t)
#f)))) ;; less than 10 seconds per count - start up a server
;; cmd is a symbol
;; vars is a json string encoding the parameters for the call
;;
(define (rmt:send-receive cmd rid params)
|
71
72
73
74
75
76
77
78
79
80
81
82
83
84
|
#f
(let loop ((numtries 100))
(let ((res (client:setup run-id)))
(if res
(hash-table-ref/default *runremote* run-id #f) ;; client:setup filled this in (hopefully)
(if (> numtries 0)
(begin
(thread-sleep! 10)
(loop (- numtries 1)))
(begin
(debug:print 0 "ERROR: 100 tries and no server, giving up")
(exit 1))))))))))
(jparams (db:obj->string params)))
(if connection-info
|
>
>
>
|
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
|
#f
(let loop ((numtries 100))
(let ((res (client:setup run-id)))
(if res
(hash-table-ref/default *runremote* run-id #f) ;; client:setup filled this in (hopefully)
(if (> numtries 0)
(begin
;; junk records can cause stuckness here. use this time to
;; clean out
(open-run-close tasks:server-clean-out-old-records-for-run-id tasks:open-db run-id "auto-start-clean-up")
(thread-sleep! 10)
(loop (- numtries 1)))
(begin
(debug:print 0 "ERROR: 100 tries and no server, giving up")
(exit 1))))))))))
(jparams (db:obj->string params)))
(if connection-info
|