| ︙ | | | ︙ | |
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
|
(exit))))
(let* ((dbpath (conc *toppath* "/megatest.db")) ;; fname)
(dbexists (file-exists? dbpath))
(write-access (file-write-access? dbpath))
(db (sqlite3:open-database dbpath)) ;; (never-give-up-open-db dbpath))
(handler (make-busy-timeout (if (args:get-arg "-override-timeout")
(string->number (args:get-arg "-override-timeout"))
30)))) ;; 136000))) ;; 136000 = 2.2 minutes
(if (and dbexists
(not write-access))
(set! *db-write-access* write-access)) ;; only unset so other db's also can use this control
(debug:print-info 11 "open-db, dbpath=" dbpath " argv=" (argv))
(if write-access (sqlite3:set-busy-handler! db handler))
(if (not dbexists)
(db:initialize db))
|
|
|
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
|
(exit))))
(let* ((dbpath (conc *toppath* "/megatest.db")) ;; fname)
(dbexists (file-exists? dbpath))
(write-access (file-write-access? dbpath))
(db (sqlite3:open-database dbpath)) ;; (never-give-up-open-db dbpath))
(handler (make-busy-timeout (if (args:get-arg "-override-timeout")
(string->number (args:get-arg "-override-timeout"))
6000)))) ;; NB// this is in milliseconds. 136000))) ;; 136000 = 2.2 minutes
(if (and dbexists
(not write-access))
(set! *db-write-access* write-access)) ;; only unset so other db's also can use this control
(debug:print-info 11 "open-db, dbpath=" dbpath " argv=" (argv))
(if write-access (sqlite3:set-busy-handler! db handler))
(if (not dbexists)
(db:initialize db))
|
| ︙ | | | ︙ | |
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|
(debug:print-info 11 "open-run-close-no-exception-handling END" )
res)
#f))
(define (open-run-close-exception-handling proc idb . params)
(handle-exceptions
exn
(begin
(debug:print 0 "EXCEPTION: database probably overloaded or unreadable.")
(debug:print 0 " " ((condition-property-accessor 'exn 'message) exn))
(print-call-chain)
(thread-sleep! (random 120))
(debug:print-info 0 "trying db call one more time....this may never recover, if necessary kill process " (current-process-id) " on host " (current-host-name) " to clean up")
(apply open-run-close-no-exception-handling proc idb params))
|
>
>
>
|
>
>
|
|
>
>
|
|
|
|
|
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
(debug:print-info 11 "open-run-close-no-exception-handling END" )
res)
#f))
(define (open-run-close-exception-handling proc idb . params)
(handle-exceptions
exn
(let ((sleep-time (random 30))
(err-status ((condition-property-accessor 'sqlite3 'status #f) exn)))
(case err-status
((busy)
(thread-sleep! sleep-time))
(else
(debug:print 0 "EXCEPTION: database probably overloaded or unreadable.")
(debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
(print "exn=" (condition->list exn))
(debug:print 0 " status: " ((condition-property-accessor 'sqlite3 'status) exn))
(print-call-chain)
(thread-sleep! sleep-time)
(debug:print-info 0 "trying db call one more time....this may never recover, if necessary kill process " (current-process-id) " on host " (get-host-name) " to clean up")))
(apply open-run-close-exception-handling proc idb params))
(apply open-run-close-no-exception-handling proc idb params)))
;; (define open-run-close open-run-close-exception-handling)
(define open-run-close open-run-close-exception-handling)
(define *global-delta* 0)
(define *last-global-delta-printed* 0)
|
| ︙ | | | ︙ | |
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
|
;; db should be db open proc or #f
(define (cdb:remote-run proc db . params)
(if (or *db-write-access*
(not (member proc *db:all-write-procs*)))
(handle-exceptions
exn
(begin
(debug:print 0 "Problem with call to cdb:remote-run, database may be locked and read-only, waiting and trying again ...")
(thread-sleep! 10)
|
>
>
>
>
|
|
|
|
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
|
;; db should be db open proc or #f
(define (cdb:remote-run proc db . params)
(if (or *db-write-access*
(not (member proc *db:all-write-procs*)))
(handle-exceptions
exn
(let ((sleep-time (random 20))
(err-status ((condition-property-accessor 'sqlite3 'status #f) exn)))
(case err-status
((busy)(thread-sleep! 4))
(else
(debug:print 0 "WARNING: possible problem with call to cdb:remote-run, database may be read-only and locked, waiting and trying again ...")
(thread-sleep! sleep-time)))
(apply cdb:remote-run proc db params))
(apply cdb:client-call *runremote* 'immediate #f *default-numtries* open-run-close proc #f params))
(begin
(debug:print 0 "ERROR: Attempt to access read-only database")
#f)))
(define (db:test-get-logfile-info db run-id test-name)
|
| ︙ | | | ︙ | |
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
|
(if query
;; hand queries off to the write queue
(let ((response (case *transport-type*
((http)
(debug:print-info 7 "Queuing item " item " for wrapped write")
(db:queue-write-and-wait db qry-sig query params))
(else
(apply sqlite3:execute db query params)
#t))))
(debug:print-info 7 "Received " response " from wrapped write")
(server:reply return-address qry-sig response response))
;; otherwise if appropriate flush the queue (this is a read or complex query)
(begin
(cond
((member stmt-key db:special-queries)
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
|
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
|
(if query
;; hand queries off to the write queue
(let ((response (case *transport-type*
((http)
(debug:print-info 7 "Queuing item " item " for wrapped write")
(db:queue-write-and-wait db qry-sig query params))
(else
(let* ((remtries 10)
(proc #f))
(set! proc (lambda (remtries)
(if (> remtries 0)
(handle-exceptions
exn
(let ((sleep-time (random 30))
(err-status ((condition-property-accessor 'sqlite3 'status #f) exn)))
(case err-status
((busy)
(thread-sleep! sleep-time)
(proc 10)) ;; we never give up on busy
(else
(debug:print 0 "EXCEPTION: database probably overloaded or unreadable.")
(debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
(debug:print 0 " status: " ((condition-property-accessor 'sqlite3 'status) exn))
(print-call-chain)
(debug:print 0 "Sleeping for " sleep-time)
(thread-sleep! sleep-time)
(debug:print-info 0 "trying db call one more time....this may never recover, if necessary kill process " (current-process-id) " on host " (get-host-name) " to clean up")
(proc (- remtries 1)))))
(apply sqlite3:execute db query params))
(debug:print 0 "ERROR: too many attempts to access db were made and no sucess. query: "
query ", params: " params))))
(proc remtries))
#t))))
(debug:print-info 7 "Received " response " from wrapped write")
(server:reply return-address qry-sig response response))
;; otherwise if appropriate flush the queue (this is a read or complex query)
(begin
(cond
((member stmt-key db:special-queries)
|
| ︙ | | | ︙ | |