234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
|
(let* ((send-recieve (lambda ()
(mutex-lock! *http-mutex*)
;; (condition-case (with-input-from-request "http://localhost"; #f read-lines)
;; ((exn http client-error) e (print e)))
(set! res (vector
success
(db:string->obj
;; handle-exceptions
;; exn
;; (begin
;; (set! success #f)
;; (debug:print 0 *default-log-port* "WARNING: failure in with-input-from-request to " fullurl ".")
;; (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
;; (if *runremote*
;; (remote-conndat-set! *runremote* #f))
;; ;; 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?
;; (mutex-unlock! *http-mutex*)
;; ;;; (signal (make-composite-condition
;; ;;; (make-property-condition 'commfail 'message "failed to connect to server")))
;; ;;; "communications failed"
;; (db:obj->string #f))
(with-input-from-request ;; was dat
fullurl
(list (cons 'key "thekey")
(cons 'cmd cmd)
(cons 'params sparams))
read-string)
transport: 'http)
0)) ;; added this speculatively
;; Shouldn't this be a call to the managed call-all-connections stuff above?
(close-all-connections!)
(mutex-unlock! *http-mutex*)
))
(time-out (lambda ()
(thread-sleep! 45)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
|
(let* ((send-recieve (lambda ()
(mutex-lock! *http-mutex*)
;; (condition-case (with-input-from-request "http://localhost"; #f read-lines)
;; ((exn http client-error) e (print e)))
(set! res (vector
success
(db:string->obj
(handle-exceptions
exn
(begin
(set! success #f)
(debug:print 0 *default-log-port* "WARNING: failure in with-input-from-request to " fullurl ".")
(debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
(if *runremote*
(remote-conndat-set! *runremote* #f))
;; 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?
(mutex-unlock! *http-mutex*)
;;; (signal (make-composite-condition
;;; (make-property-condition 'commfail 'message "failed to connect to server")))
;;; "communications failed"
(db:obj->string #f))
(with-input-from-request ;; was dat
fullurl
(list (cons 'key "thekey")
(cons 'cmd cmd)
(cons 'params sparams))
read-string)
transport: 'http))
0)) ;; added this speculatively
;; Shouldn't this be a call to the managed call-all-connections stuff above?
(close-all-connections!)
(mutex-unlock! *http-mutex*)
))
(time-out (lambda ()
(thread-sleep! 45)
|
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
|
;; (> rem-time 0))
;; (thread-sleep! rem-time)
;; (thread-sleep! 4))) ;; fallback for if the math is changed ...
(define (http-transport:server-shutdown server-id port)
(let ((tdbdat (tasks:open-db)))
(debug:print-info 0 *default-log-port* "Starting to shutdown the server.")
;; need to delete only *my* server entry (future use)
;; (if *dbstruct-db* (db:sync-touched *dbstruct-db* *run-id* force-sync: #t)) ;; handled in the watchdog only
(set! *time-to-exit* #t) ;; tell on-exit to be fast as we've already cleaned up
|
<
<
<
>
|
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
|
;; (> rem-time 0))
;; (thread-sleep! rem-time)
;; (thread-sleep! 4))) ;; fallback for if the math is changed ...
(define (http-transport:server-shutdown server-id port)
(let ((tdbdat (tasks:open-db)))
(debug:print-info 0 *default-log-port* "Starting to shutdown the server.")
;;
;; start_shutdown
;;
(tasks:server-set-state! (db:delay-if-busy tdbdat) server-id "shutting-down")
(set! *time-to-exit* #t) ;; tell on-exit to be fast as we've already cleaned up
(portlogger:open-run-close portlogger:set-port port "released")
(thread-sleep! 5)
(debug:print-info 0 *default-log-port* "Max cached queries was " *max-cache-size*)
(debug:print-info 0 *default-log-port* "Number of cached writes " *number-of-writes*)
(debug:print-info 0 *default-log-port* "Average cached write time "
(if (eq? *number-of-writes* 0)
"n/a (no writes)"
|