1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
|
(thread-join! th1)
(debug:print-info 11 "cdb:client-call returning res=" res)
res))))))
(define (cdb:set-verbosity serverdat val)
(cdb:client-call serverdat 'set-verbosity #f *default-numtries* val))
(define (cdb:login serverdat keyval signature)
(cdb:client-call serverdat 'login #t *default-numtries* keyval megatest-version signature))
(define (cdb:logout serverdat keyval signature)
(cdb:client-call serverdat 'logout #t *default-numtries* keyval signature))
|
<
<
<
<
<
<
|
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
|
(thread-join! th1)
(debug:print-info 11 "cdb:client-call returning res=" res)
res))))))
(define (cdb:set-verbosity serverdat val)
(cdb:client-call serverdat 'set-verbosity #f *default-numtries* val))
(define (cdb:num-clients serverdat)
(cdb:client-call serverdat 'numclients #t *default-numtries*))
;; I think this would be more efficient if executed on client side FIXME???
(define (cdb:test-set-status-state serverdat test-id status state msg)
(if (member state '("LAUNCHED" "REMOTEHOSTSTART"))
(cdb:client-call serverdat 'set-test-start-time #t *default-numtries* test-id))
|
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
|
;; ;; Do a little record keeping
;; (let ((cache-size (length data)))
;; (if (> cache-size *max-cache-size*)
;; (set! *max-cache-size* cache-size)))
;; #t)
;; #f)))
(define (db:login db keyval calling-path calling-version client-signature)
(if (and (equal? calling-path *toppath*)
(equal? megatest-version calling-version))
(begin
(hash-table-set! *logged-in-clients* client-key (current-seconds))
'(#t "successful login")) ;; path matches - pass! Should vet the caller at this time ...
(list #f (conc "Login failed due to mismatch paths: " calling-path ", " *toppath*))))
(define (db:process-write db request-item)
(let ((stmt-key (vector-ref request-item 0))
(query (vector-ref request-item 1))
(params (vector-ref request-item 2))
|
|
|
|
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
|
;; ;; Do a little record keeping
;; (let ((cache-size (length data)))
;; (if (> cache-size *max-cache-size*)
;; (set! *max-cache-size* cache-size)))
;; #t)
;; #f)))
(define (db:login db calling-path calling-version client-signature)
(if (and (equal? calling-path *toppath*)
(equal? megatest-version calling-version))
(begin
(hash-table-set! *logged-in-clients* client-signature (current-seconds))
'(#t "successful login")) ;; path matches - pass! Should vet the caller at this time ...
(list #f (conc "Login failed due to mismatch paths: " calling-path ", " *toppath*))))
(define (db:process-write db request-item)
(let ((stmt-key (vector-ref request-item 0))
(query (vector-ref request-item 1))
(params (vector-ref request-item 2))
|