︙ | | | ︙ | |
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
|
;; get the sender info
;; this should match (server:get-client-signature)
;; we will need to process "all" messages here some day
(rmsg sub-socket)
;; now get the actual message
(set! res (db:string->obj (rmsg sub-socket))))))
(timeout (lambda ()
(thread-sleep! 5)
(if (not res)
(if (> numretries 0)
(begin
(debug:print 0 "WARNING: no reply to query " params ", trying again")
(apply cdb:client-call zmq-sockets qtype immediate (- numretries 1) params))
(begin
(debug:print 0 "ERROR: cdb:client-call timed out " params ", exiting.")
|
|
|
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
|
;; get the sender info
;; this should match (server:get-client-signature)
;; we will need to process "all" messages here some day
(rmsg sub-socket)
;; now get the actual message
(set! res (db:string->obj (rmsg sub-socket))))))
(timeout (lambda ()
(thread-sleep! 60)
(if (not res)
(if (> numretries 0)
(begin
(debug:print 0 "WARNING: no reply to query " params ", trying again")
(apply cdb:client-call zmq-sockets qtype immediate (- numretries 1) params))
(begin
(debug:print 0 "ERROR: cdb:client-call timed out " params ", exiting.")
|
︙ | | | ︙ | |
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
|
'(delete-tests-in-state "DELETE FROM tests WHERE state=? AND run_id=?;")
'(tests:test-set-toplog "UPDATE tests SET final_logf=? WHERE run_id=? AND testname=? AND item_path='';")
))
;; do not run these as part of the transaction
(define db:special-queries '(rollup-tests-pass-fail
db:roll-up-pass-fail-counts
login))
;; not used, intended to indicate to run in calling process
(define db:run-local-queries '()) ;; rollup-tests-pass-fail))
;; The queue is a list of vectors where the zeroth slot indicates the type of query to
;; apply and the second slot is the time of the query and the third entry is a list of
;; values to be applied
|
|
>
|
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
|
'(delete-tests-in-state "DELETE FROM tests WHERE state=? AND run_id=?;")
'(tests:test-set-toplog "UPDATE tests SET final_logf=? WHERE run_id=? AND testname=? AND item_path='';")
))
;; do not run these as part of the transaction
(define db:special-queries '(rollup-tests-pass-fail
db:roll-up-pass-fail-counts
login
immediate))
;; not used, intended to indicate to run in calling process
(define db:run-local-queries '()) ;; rollup-tests-pass-fail))
;; The queue is a list of vectors where the zeroth slot indicates the type of query to
;; apply and the second slot is the time of the query and the third entry is a list of
;; values to be applied
|
︙ | | | ︙ | |
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
|
(if special-qry
;; handle a query that cannot be part of the grouped queries
(let* ((stmt-key (cdb:packet-get-qtype special-qry))
(return-address (cdb:packet-get-client-sig special-qry))
(qry (hash-table-ref/default queries stmt-key #f))
(params (cdb:packet-get-params special-qry)))
(cond
((string? qry)
(apply sqlite3:execute db qry params)
(server:reply pubsock return-address #t))
((procedure? stmt-key)
;; we are being handed a procedure so call it
(debug:print-info 11 "Running (apply " stmt-key " " db " " params ")")
(server:reply pubsock return-address (apply stmt-key db params)))
(else
(case stmt-key
((login)
(if (< (length params) 3) ;; should get toppath, version and signature
'(#f "login failed due to missing params") ;; missing params
(let ((calling-path (car params))
(calling-vers (cadr params))
(client-key (caddr params)))
(if (and (equal? calling-path *toppath*)
|
>
>
>
|
>
>
|
|
|
>
>
>
>
>
>
>
|
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
|
(if special-qry
;; handle a query that cannot be part of the grouped queries
(let* ((stmt-key (cdb:packet-get-qtype special-qry))
(return-address (cdb:packet-get-client-sig special-qry))
(qry (hash-table-ref/default queries stmt-key #f))
(params (cdb:packet-get-params special-qry)))
(debug:print-info 11 "Special queries/requests stmt-key=" stmt-key ", return-address=" return-address ", qry=" qry ", params=" params)
(cond
;; Special queries
((string? qry)
(apply sqlite3:execute db qry params)
(server:reply pubsock return-address #t))
;; ((and (not (null? params))
;; (procedure? (car params)))
;; (let ((proc (car params))
;; (remparams (cdr params)))
;; ;; we are being handed a procedure so call it
;; (debug:print-info 11 "Running (apply " proc " " db " " remparams ")")
;; (server:reply pubsock return-address (apply proc db remparams))))
(else
(case stmt-key
((immediate)
(let ((proc (car params))
(remparams (cdr params)))
;; we are being handed a procedure so call it
(debug:print-info 11 "Running (apply " proc " " remparams ")")
(server:reply pubsock return-address (apply proc remparams))))
((login)
(if (< (length params) 3) ;; should get toppath, version and signature
'(#f "login failed due to missing params") ;; missing params
(let ((calling-path (car params))
(calling-vers (cadr params))
(client-key (caddr params)))
(if (and (equal? calling-path *toppath*)
|
︙ | | | ︙ | |
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
|
(if (null? stmts)
stmts
(let innerloop ((hed (car stmts))
(tal (cdr stmts)))
(let ((params (cdb:packet-get-params hed))
(return-address (cdb:packet-get-client-sig hed))
(stmt-key (cdb:packet-get-qtype hed)))
(if (or (procedure? stmt-key)
(member stmt-key db:special-queries))
(begin
(debug:print-info 11 "Handling special statement " stmt-key)
(cons hed tal))
(begin
(debug:print-info 11 "Executing " stmt-key " for " params)
(apply sqlite3:execute (hash-table-ref queries stmt-key) params)
(server:reply pubsock return-address #t)
|
<
|
|
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
|
(if (null? stmts)
stmts
(let innerloop ((hed (car stmts))
(tal (cdr stmts)))
(let ((params (cdb:packet-get-params hed))
(return-address (cdb:packet-get-client-sig hed))
(stmt-key (cdb:packet-get-qtype hed)))
(if (member stmt-key db:special-queries)
(begin
(debug:print-info 11 "Handling special statement " stmt-key)
(cons hed tal))
(begin
(debug:print-info 11 "Executing " stmt-key " for " params)
(apply sqlite3:execute (hash-table-ref queries stmt-key) params)
(server:reply pubsock return-address #t)
|
︙ | | | ︙ | |