66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
|
(if (not *toppath*)
(if (not (setup-for-run))
(begin
(debug:print 0 "ERROR: Attempted to open db when not in megatest area. Exiting.")
(exit))))
(let* ((dbpath (conc *toppath* "/megatest.db")) ;; fname)
(dbexists (file-exists? dbpath))
(db (sqlite3:open-database dbpath)) ;; (never-give-up-open-db dbpath))
(handler (make-busy-timeout (if (args:get-arg "-override-timeout")
(string->number (args:get-arg "-override-timeout"))
136000)))) ;; 136000))) ;; 136000 = 2.2 minutes
(debug:print-info 11 "open-db, dbpath=" dbpath " argv=" (argv))
(sqlite3:set-busy-handler! db handler)
(if (not dbexists)
(db:initialize db))
(db:set-sync db)
db))
|
>
>
>
>
|
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
|
(if (not *toppath*)
(if (not (setup-for-run))
(begin
(debug:print 0 "ERROR: Attempted to open db when not in megatest area. Exiting.")
(exit))))
(let* ((dbpath (conc *toppath* "/megatest.db")) ;; fname)
(dbexists (file-exists? dbpath))
(write-access (file-write-access? dbpath))
(db (sqlite3:open-database dbpath)) ;; (never-give-up-open-db dbpath))
(handler (make-busy-timeout (if (args:get-arg "-override-timeout")
(string->number (args:get-arg "-override-timeout"))
136000)))) ;; 136000))) ;; 136000 = 2.2 minutes
(if (and dbexists
(not write-access))
(set! *db-write-access* write-access)) ;; only unset so other db's also can use this control
(debug:print-info 11 "open-db, dbpath=" dbpath " argv=" (argv))
(sqlite3:set-busy-handler! db handler)
(if (not dbexists)
(db:initialize db))
(db:set-sync db)
db))
|
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
|
(query-sig (message-digest-string (md5-primitive) (conc qtype immediate params)))
(zdat (db:obj->string (vector client-sig qtype immediate query-sig params (current-seconds))))) ;; (with-output-to-string (lambda ()(serialize params))))
(debug:print-info 11 "zdat=" zdat)
(let* ((res #f)
(rawdat (http-transport:client-send-receive serverdat zdat))
(tmp #f))
(debug:print-info 11 "Sent " zdat ", received " rawdat)
(set! tmp (db:string->obj rawdat))
(vector-ref tmp 2))))
((zmq)
(handle-exceptions
exn
(begin
(debug:print-info 0 "cdb:client-call timeout or error. Trying again in 5 seconds")
(thread-sleep! 5)
(if (> numretries 0)(apply cdb:client-call serverdat qtype immediate (- numretries 1) params)))
|
>
>
|
|
>
>
>
|
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
|
(query-sig (message-digest-string (md5-primitive) (conc qtype immediate params)))
(zdat (db:obj->string (vector client-sig qtype immediate query-sig params (current-seconds))))) ;; (with-output-to-string (lambda ()(serialize params))))
(debug:print-info 11 "zdat=" zdat)
(let* ((res #f)
(rawdat (http-transport:client-send-receive serverdat zdat))
(tmp #f))
(debug:print-info 11 "Sent " zdat ", received " rawdat)
(if rawdat
(begin
(set! tmp (db:string->obj rawdat))
(vector-ref tmp 2))
(begin
(debug:print 0 "ERROR: Communication with the server failed. Exiting if possible")
(exit 1))))))
((zmq)
(handle-exceptions
exn
(begin
(debug:print-info 0 "cdb:client-call timeout or error. Trying again in 5 seconds")
(thread-sleep! 5)
(if (> numretries 0)(apply cdb:client-call serverdat qtype immediate (- numretries 1) params)))
|