1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
|
(cached? (cadr params))
(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 (< (length remparam) 2) ;; should get toppath and signature
'(#f "login failed due to missing params") ;; missing params
(let ((calling-path (car remparam))
(client-key (cadr remparam)))
(if (equal? calling-path *toppath*)
(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*))))))
((logout)
(if (and (> (length remparam) 1)
(eq? *toppath* (car remparam))
|
|
|
|
>
|
|
>
|
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
|
(cached? (cadr params))
(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 and version matches
(if (< (length remparam) 3) ;; should get toppath, version and signature
'(#f "login failed due to missing params") ;; missing params
(let ((calling-path (car remparam))
(calling-vers (cadr remparam))
(client-key (caddr remparam)))
(if (and (equal? calling-path *toppath*)
(equal? megatest-version calling-vers))
(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*))))))
((logout)
(if (and (> (length remparam) 1)
(eq? *toppath* (car remparam))
|
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
|
(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:num-clients zmq-socket)
(cdb:client-call zmq-socket 'numclients #t))
|
|
|
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
|
(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 megatest-version signature))
(define (cdb:logout zmq-socket keyval signature)
(cdb:client-call zmq-socket 'logout #t keyval signature))
(define (cdb:num-clients zmq-socket)
(cdb:client-call zmq-socket 'numclients #t))
|