1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
|
(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)
|
|
|
|
>
|
|
<
>
|
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
|
(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))
(hash-table-ref/default *logged-in-clients* (cadr remparam) #f))
#t
#f))
((flush)
|
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
|
(let ((stmt (alist-ref stmt-key db:queries)))
(if stmt
(hash-table-set! queries stmt-key (sqlite3:prepare db (car stmt)))
(if (procedure? stmt-key)
(hash-table-set! queries stmt-key #f)
(debug:print 0 "ERROR: Missing query spec for " stmt-key "!")))))))
data)
;; outer loop to handle special queries that cannot be handled in the
;; transaction.
(let outerloop ((special-qry #f)
(stmts data))
(if special-qry
;; handle a query that cannot be part of the grouped queries
|
|
|
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
|
(let ((stmt (alist-ref stmt-key db:queries)))
(if stmt
(hash-table-set! queries stmt-key (sqlite3:prepare db (car stmt)))
(if (procedure? stmt-key)
(hash-table-set! queries stmt-key #f)
(debug:print 0 "ERROR: Missing query spec for " stmt-key "!")))))))
data)
;; outer loop to handle special queries that cannot be handled in the
;; transaction.
(let outerloop ((special-qry #f)
(stmts data))
(if special-qry
;; handle a query that cannot be part of the grouped queries
|