| ︙ | | |
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
|
56
57
58
59
60
61
62
63
64
65
66
67
68
69
|
-
|
(ipaddrstr (let ((ipstr (if (string=? "-" hostn)
;; (string-intersperse (map number->string (u8vector->list (hostname->ip hostname))) ".")
(server:get-best-guess-address hostname)
#f)))
(if ipstr ipstr hostn))) ;; hostname)))
(start-port (portlogger:open-run-close portlogger:find-port))
(link-tree-path (configf:lookup *configdat* "setup" "linktree")))
;; (set! db *inmemdb*)
|
| ︙ | | |
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
|
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
|
-
+
|
;; This is were we set up the database connections
(let* (($ (request-vars source: 'both))
(dat ($ 'dat))
(res #f))
(cond
((equal? (uri-path (request-uri (current-request)))
'(/ "api"))
(send-response body: (api:process-request *inmemdb* $) ;; the $ is the request vars proc
(send-response body: (api:process-request *dbstruct-db* $) ;; the $ is the request vars proc
headers: '((content-type text/plain)))
(mutex-lock! *heartbeat-mutex*)
(set! *last-db-access* (current-seconds))
(mutex-unlock! *heartbeat-mutex*))
((equal? (uri-path (request-uri (current-request)))
'(/ ""))
(send-response body: (http-transport:main-page)))
|
| ︙ | | |
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
|
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 ...")
|
| ︙ | | |
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
|
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))
|
| ︙ | | |
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
|
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)))
|
| ︙ | | |
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
|
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
|
-
-
+
+
-
+
+
-
+
-
+
-
+
-
-
-
-
+
+
|
(port (cadr server-info))
(last-access 0)
(server-timeout (server:get-timeout)))
(let loop ((count 0)
(server-state 'available)
(bad-sync-count 0))
;; Use this opportunity to sync the inmemdb to db
(if *inmemdb*
;; 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))
;; inmemdb is a dbstruct
(db:sync-touched *inmemdb* *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)
(debug:print-error 0 *default-log-port* "error from sync code other than 'sync-failed. Attempting to gracefully shutdown the server")
(tasks:server-delete-record (db:delay-if-busy tdbdat) server-id " http-transport:keep-running crashed")
(exit)))
(set! sync-time (- (current-milliseconds) start-time))
(set! rem-time (quotient (- 4000 sync-time) 1000))
(debug:print 4 *default-log-port* "SYNC: time= " sync-time ", rem-time=" rem-time)
(if (and (<= rem-time 4)
(> rem-time 0))
(thread-sleep! rem-time)
(thread-sleep! 4))) ;; fallback for if the math is changed ...
;;
;; no *inmemdb* yet, set running after our first pass through and start the db
;; no *dbstruct-db* yet, set running after our first pass through and start the db
;;
(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))
(set! *dbstruct-db* (db:setup)) ;; run-id))
;; force initialization
;; (db:get-db *inmemdb* #t)
(db:get-db *inmemdb* run-id)
(tasks:server-set-state! (db:delay-if-busy tdbdat) server-id "running"))
|
| ︙ | | |
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
|
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
|
+
-
+
-
|
(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)) ;; handled in the watchdog only
(set! *time-to-exit* #t)
(set! *time-to-exit* #t) ;; tell on-exit to be fast as we've already cleaned up
(if *inmemdb* (db:sync-touched *inmemdb* *run-id* force-sync: #t))
|
| ︙ | | |
513
514
515
516
517
518
519
520
521
522
523
524
525
526
|
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)
|
| ︙ | | |