| ︙ | | |
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
|
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
|
-
+
|
(res #f))
(cond
((equal? (uri-path (request-uri (current-request)))
'(/ "api"))
(send-response body: (api:process-request *dbstruct-db* $) ;; the $ is the request vars proc
headers: '((content-type text/plain)))
(mutex-lock! *heartbeat-mutex*)
(set! *db-last-access* (current-seconds))
(set! *last-db-access* (current-seconds))
(mutex-unlock! *heartbeat-mutex*))
((equal? (uri-path (request-uri (current-request)))
'(/ ""))
(send-response body: (http-transport:main-page)))
((equal? (uri-path (request-uri (current-request)))
'(/ "json_api"))
(send-response body: (http-transport:main-page)))
|
| ︙ | | |
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
|
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
|
-
+
-
+
|
(if (or (not (equal? sdat (list iface port)))
(not server-id))
(begin
(debug:print-info 0 *default-log-port* "interface changed, refreshing iface and port info")
(set! iface (car sdat))
(set! port (cadr sdat))))
;; Transfer *db-last-access* to last-access to use in checking that we are still alive
;; Transfer *last-db-access* to last-access to use in checking that we are still alive
(mutex-lock! *heartbeat-mutex*)
(set! last-access *db-last-access*)
(set! last-access *last-db-access*)
(mutex-unlock! *heartbeat-mutex*)
;; (debug:print 11 *default-log-port* "last-access=" last-access ", server-timeout=" server-timeout)
;;
;; no_traffic, no running tests, if server 0, no running servers
;;
;; (let ((wait-on-running (configf:lookup *configdat* "server" b"wait-on-running"))) ;; wait on running tasks (if not true then exit on time out)
|
| ︙ | | |
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
|
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
|
-
+
-
+
|
(if (and (server:read-dotserver *toppath*)
(server:check-if-running run-id))
(begin
(debug:print 0 *default-log-port* "INFO: Server for run-id " run-id " already running")
(exit 0))
(begin ;; ok, no server detected, clean out any lingering records
(tasks:server-force-clean-running-records-for-run-id (db:delay-if-busy tdbdat) run-id "notresponding")))
(let loop ((server-id (tasks:server-lock-slot (db:delay-if-busy tdbdat) run-id))
(let loop ((server-id (tasks:server-lock-slot (db:delay-if-busy tdbdat) run-id 'http))
(remtries 4))
(if (not server-id)
(if (> remtries 0)
(begin
(thread-sleep! 2)
(loop (tasks:server-lock-slot (db:delay-if-busy tdbdat) run-id)
(loop (tasks:server-lock-slot (db:delay-if-busy tdbdat) run-id 'http)
(- remtries 1)))
(begin
;; since we didn't get the server lock we are going to clean up and bail out
(debug:print-info 2 *default-log-port* "INFO: server pid=" (current-process-id) ", hostname=" (get-host-name) " not starting due to other candidates ahead in start queue")
(tasks:server-delete-records-for-this-pid (db:delay-if-busy tdbdat) " http-transport:launch")
(delete-file* (conc *toppath* "/.starting-server"))
))
|
| ︙ | | |
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
|
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
|
-
+
|
" ms</td></tr>"
"<tr><td>Number non-cached queries</td> <td>" *number-non-write-queries* "</td></tr>"
"<tr><td>Average non-cached time</td> <td>" (if (eq? *number-non-write-queries* 0)
"n/a (no queries)"
(/ *total-non-write-delay*
*number-non-write-queries*))
" ms</td></tr>"
"<tr><td>Last access</td><td>" (seconds->time-string *db-last-access*) "</td></tr>"
"<tr><td>Last access</td><td>" (seconds->time-string *last-db-access*) "</td></tr>"
"</table>")))
(mutex-unlock! *heartbeat-mutex*)
res))
(define (http-transport:runs linkpath)
(conc "<h3>Runs</h3>"
(string-intersperse
|
| ︙ | | |