270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
|
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
|
-
+
|
exn
(begin
(set! success #f)
(debug:print 0 "WARNING: failure in with-input-from-request to " fullurl ".")
(debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
(hash-table-delete! *runremote* run-id)
;; Killing associated server to allow clean retry.")
(tasks:kill-server-run-id run-id) ;; better to kill the server in the logic that called this routine?
;; (tasks:kill-server-run-id run-id) ;; better to kill the server in the logic that called this routine?
(mutex-unlock! *http-mutex*)
(signal (make-composite-condition
(make-property-condition 'commfail 'message "failed to connect to server")))
"communications failed")
(with-input-from-request ;; was dat
fullurl
(list (cons 'key "thekey")
|
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
|
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
|
-
-
+
+
-
+
-
-
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
|
(th1 (make-thread send-recieve "with-input-from-request"))
(th2 (make-thread time-out "time out")))
(thread-start! th1)
(thread-start! th2)
(thread-join! th1)
(thread-terminate! th2)
(debug:print-info 11 "got res=" res)
(if (vector? res)
(if (vector-ref res 0)
(if (and res (vector? res))
(if (safe-vector-ref res 0)
res
(begin ;; note: this code also called in nmsg-transport - consider consolidating it
(debug:print 0 "ERROR: error occured at server, info=" (vector-ref res 2))
(debug:print 0 "ERROR: error occured at server, info=" (safe-vector-ref res 2))
(debug:print 0 " client call chain:")
(print-call-chain (current-error-port))
(debug:print 0 " server call chain:")
(pp (vector-ref res 1) (current-error-port))
(signal (vector-ref result 0))))
(pp (safe-vector-ref res 1) (current-error-port))
(signal (safe-vector-ref result 0))))
(signal (make-composite-condition
(make-property-condition
'timeout
'message "nmsg-transport:client-api-send-receive-raw timed out talking to server")))))))
;; careful closing of connections stored in *runremote*
;;
(define (http-transport:close-connections run-id)
(let* ((server-dat (hash-table-ref/default *runremote* run-id #f)))
(if (vector? server-dat)
(let ((api-dat (http-transport:server-dat-get-api-uri server-dat)))
(close-connection! api-dat)
#t)
#f)))
(define (make-http-transport:server-dat)(make-vector 6))
(define (http-transport:server-dat-get-iface vec) (vector-ref vec 0))
(define (http-transport:server-dat-get-port vec) (vector-ref vec 1))
(define (http-transport:server-dat-get-api-uri vec) (vector-ref vec 2))
(define (http-transport:server-dat-get-api-url vec) (vector-ref vec 3))
(define (http-transport:server-dat-get-api-req vec) (vector-ref vec 4))
(define (http-transport:server-dat-get-last-access vec) (vector-ref vec 5))
(define (http-transport:server-dat-get-socket vec) (vector-ref vec 6))
(define (http-transport:server-dat-get-iface vec) (safe-vector-ref vec 0))
(define (http-transport:server-dat-get-port vec) (safe-vector-ref vec 1))
(define (http-transport:server-dat-get-api-uri vec) (safe-vector-ref vec 2))
(define (http-transport:server-dat-get-api-url vec) (safe-vector-ref vec 3))
(define (http-transport:server-dat-get-api-req vec) (safe-vector-ref vec 4))
(define (http-transport:server-dat-get-last-access vec) (safe-vector-ref vec 5))
(define (http-transport:server-dat-get-socket vec) (safe-vector-ref vec 6))
(define (http-transport:server-dat-make-url vec)
(if (and (http-transport:server-dat-get-iface vec)
(http-transport:server-dat-get-port vec))
(conc "http://"
(http-transport:server-dat-get-iface vec)
":"
|
435
436
437
438
439
440
441
442
443
444
445
446
447
448
|
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
|
+
|
(if (eq? server-state 'available)
(let ((new-server-id (tasks:server-am-i-the-server? (db:delay-if-busy tdbdat) run-id))) ;; try to ensure no double registering of servers
(if (equal? new-server-id server-id)
(begin
(tasks:server-set-state! (db:delay-if-busy tdbdat) server-id "dbprep")
(thread-sleep! 0.5) ;; give some margin for queries to complete before switching from file based access to server based access
(set! *inmemdb* (db:setup run-id))
(thread-sleep! 0.1)
(tasks:server-set-state! (db:delay-if-busy tdbdat) server-id "running"))
(begin ;; gotta exit nicely
(tasks:server-set-state! (db:delay-if-busy tdbdat) server-id "collision")
(http-transport:server-shutdown server-id port))))))
(if (< count 1) ;; 3x3 = 9 secs aprox
(loop (+ count 1) 'running bad-sync-count))
|