| ︙ | | |
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|
-
+
|
(http-transport:try-start-server run-id ipaddrstr start-port server-id)))
;; This is recursively run by http-transport:run until sucessful
;;
(define (http-transport:try-start-server run-id ipaddrstr portnum server-id)
(let ((config-hostname (configf:lookup *configdat* "server" "hostname"))
(tdbdat (tasks:open-db)))
(debug:print-info 0 *default-log-port* "http-transport:try-start-server run-id=" run-id " ipaddrsstr=" ipaddrstr " portnum=" portnum " server-id=" server-id " config-hostname=" config-hostname)
(debug:print-info 0 *default-log-port* "http-transport:try-start-server time=" (seconds->time-string (current-seconds)) " run-id=" run-id " ipaddrsstr=" ipaddrstr " portnum=" portnum " server-id=" server-id " config-hostname=" config-hostname)
(handle-exceptions
exn
(begin
(print-error-message exn)
(if (< portnum 64000)
(begin
(debug:print 0 *default-log-port* "WARNING: attempt to start server failed. Trying again ...")
|
| ︙ | | |
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
|
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
|
-
+
|
(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))
(hash-table-delete! *runremote* run-id)
(set! *runremote* #f) ;; (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?
(mutex-unlock! *http-mutex*)
;;; (signal (make-composite-condition
;;; (make-property-condition 'commfail 'message "failed to connect to server")))
;;; "communications failed"
(db:obj->string #f))
|
| ︙ | | |
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
|
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
|
-
+
|
(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)))
(let* ((server-dat *runremote*)) ;; (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)))
|
| ︙ | | |
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
|
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
|
+
+
-
+
|
;; Use this opportunity to sync the tmp db to megatest.db
(if *dbstruct-db*
(let ((start-time (current-milliseconds))
(sync-time #f)
(rem-time #f))
(condition-case
;; (if (and (member (mutex-state *db-sync-mutex*) '(abandoned not-abandoned))
;; (> (- (current-seconds) *db-last-sync*) 5)) ;; if not currently being synced nor recently synced
(db:sync-touched *dbstruct-db* *run-id* force-sync: #t)
(db:sync-touched *dbstruct-db* *run-id* force-sync: #t) ;; usually done in the watchdog, not here.
((sync-failed)(cond
((> bad-sync-count 10) ;; time to give up
(http-transport:server-shutdown server-id port))
(else ;; (> bad-sync-count 0) ;; we've had a fail or two, delay and loop
(thread-sleep! 5)
(loop count server-state (+ bad-sync-count 1)))))
((exn)
|
| ︙ | | |
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
|
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
|
-
+
+
|
(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! *dbstruct-db* (db:setup)) ;; run-id))
(tasks:server-set-state! (db:delay-if-busy tdbdat) server-id "running"))
(tasks:server-set-state! (db:delay-if-busy tdbdat) server-id "running")
(server:write-dotserver *toppath* (conc iface ":" port)))
(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))
|
| ︙ | | |
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
|
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
|
-
+
|
(loop 0 server-state bad-sync-count))
(http-transport:server-shutdown server-id port))))))
(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))
;; (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
;;
;; start_shutdown
;;
(tasks:server-set-state! (db:delay-if-busy tdbdat) server-id "shutting-down")
(portlogger:open-run-close portlogger:set-port port "released")
(thread-sleep! 5)
|
| ︙ | | |
508
509
510
511
512
513
514
515
516
517
518
519
520
521
|
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
|
+
+
|
(if (eq? *number-non-write-queries* 0)
"n/a (no queries)"
(/ *total-non-write-delay*
*number-non-write-queries*))
" ms")
(debug:print-info 0 *default-log-port* "Server shutdown complete. Exiting")
(tasks:server-delete-record (db:delay-if-busy tdbdat) server-id " http-transport:keep-running complete")
;; if the .server file contained :myport then we can remove it
(server:remove-dotserver-file *toppath* port)
(exit)))
;; all routes though here end in exit ...
;;
;; start_server?
;;
(define (http-transport:launch run-id)
|
| ︙ | | |