1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
|
(remparam (list-tail params 2)))
(debug:print-info 12 "cdb:cached-access qry-name=" qry-name " params=" params)
(if (not cached?)(db:write-cached-data))
;; Any special calls are dispatched here.
;; Remainder are put in the db queue
(case qry-name
((login) ;; login checks that the megatest path matches
(if (null? remparam)
#f ;; no path - fail!
(let ((calling-path (car remparam)))
(if (equal? calling-path *toppath*)
#t ;; path matches - pass! Should vet the caller at this time ...
#f)))) ;; else fail to login
((flush)
(db:write-cached-data)
#t)
((immediate)
(db:write-cached-data)
(if (not (null? remparam))
(apply (car remparam) (cdr remparam))
|
|
>
>
|
>
>
>
>
>
>
|
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
|
(remparam (list-tail params 2)))
(debug:print-info 12 "cdb:cached-access qry-name=" qry-name " params=" params)
(if (not cached?)(db:write-cached-data))
;; Any special calls are dispatched here.
;; Remainder are put in the db queue
(case qry-name
((login) ;; login checks that the megatest path matches
(if (eq? (length remparam) 2) ;; should get toppath and signature
#f ;; no path - fail!
(let ((calling-path (car remparam)))
(if (equal? calling-path *toppath*)
(begin
(hash-table-set! *logged-in-clients* (cadr remparam) (current-seconds))
#t) ;; path matches - pass! Should vet the caller at this time ...
#f)))) ;; else fail to login
((logout)
(if (and (> (length remparam) 1)
(eq? *toppath* (car remparam))
(hash-table-ref/default *logged-in-clients* (cadr remparam) #f))
#t
#f))
((flush)
(db:write-cached-data)
#t)
((immediate)
(db:write-cached-data)
(if (not (null? remparam))
(apply (car remparam) (cdr remparam))
|
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
|
(let ((zdat (db:obj->string params)) ;; (with-output-to-string (lambda ()(serialize params))))
(res #f))
(send-message zmq-socket zdat)
(set! res (db:string->obj (receive-message zmq-socket zdat)))
(debug:print-info 11 "zmq-socket " (car params) " res=" res)
res))
(define (cdb:set-verbosity zmqsocket val)
(cdb:client-call zmqsocket 'set-verbosity #f val))
(define (cdb:test-set-status-state zmqsocket test-id status state msg)
(if msg
(cdb:client-call zmqsocket 'state-status-msg #t state status msg test-id)
(cdb:client-call zmqsocket 'state-status #t state status test-id))) ;; run-id test-name item-path minutes cpuload diskfree tmpfree)
(define (cdb:test-rollup-test_data-pass-fail zmqsocket test-id)
|
|
|
>
>
>
>
>
>
|
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
|
(let ((zdat (db:obj->string params)) ;; (with-output-to-string (lambda ()(serialize params))))
(res #f))
(send-message zmq-socket zdat)
(set! res (db:string->obj (receive-message zmq-socket zdat)))
(debug:print-info 11 "zmq-socket " (car params) " res=" res)
res))
(define (cdb:set-verbosity zmq-socket val)
(cdb:client-call zmq-socket 'set-verbosity #f val))
(define (cdb:login zmq-socket keyval signature)
(cdb:client-call zmq-socket 'login #t keyval signature))
(define (cdb:logout zmq-socket keyval signature)
(cdb:client-call zmq-socket 'logout #t keyval signature))
(define (cdb:test-set-status-state zmqsocket test-id status state msg)
(if msg
(cdb:client-call zmqsocket 'state-status-msg #t state status msg test-id)
(cdb:client-call zmqsocket 'state-status #t state status test-id))) ;; run-id test-name item-path minutes cpuload diskfree tmpfree)
(define (cdb:test-rollup-test_data-pass-fail zmqsocket test-id)
|