473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
|
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
|
-
+
+
|
(debug:print 0 *default-log-port* "SERVER: dbprep")
(set! *dbstruct-dbs* (db:setup #t)) ;; run-id)) FIXME!!!
(set! server-going #t)
(debug:print 0 *default-log-port* "SERVER: running, megatest version: " (common:get-full-version)) ;; NOTE: the server is NOT yet marked as running in the log. We do that in the keep-running routine.
;; (thread-start! *watchdog*)
)
(if no-sync-db
(if (and no-sync-db
(common:low-noise-print 5 "sync-all")) ;; cheesy way to reduce frequency of running sync :)
(begin
(debug:print 0 *default-log-port* "keep-running calling db:all-db-sync at " (time->string (seconds->local-time) "%H:%M:%S"))
(db:all-db-sync *dbstruct-dbs*)
;; (db:do-sync no-sync-db)
;; (db:run-lock-and-sync *no-sync-db*)
)
)
|
528
529
530
531
532
533
534
535
536
537
538
539
540
541
|
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
|
+
+
+
+
+
+
+
+
+
+
+
+
|
(flush-output *default-log-port*)))
(if (common:low-noise-print 60 "dbstats")
(begin
(debug:print 0 *default-log-port* "Server stats:")
(db:print-current-query-stats)))
(let* ((hrs-since-start (/ (- (current-seconds) server-start-time) 3600)))
(cond
((and *server-run*
(> (- (current-seconds) server-start-time) 120)) ;; let's try server replacement
;; ((adj-proc-load . 0.056875) (adj-core-load . 0.11375) (1m-load . 0.91) (5m-load . 0.77) (15m-load . 1.0) (proc . 16) (core . 8) (phys . 1))
(let* ((loaddat (common:get-normalized-cpu-load #f))
(adj-proc-load (alist-ref 'adj-proc-load loaddat))
(adj-core-load (alist-ref 'adj-core-load loaddat))
(adj-load (max adj-proc-load adj-core-load)))
(if (< adj-load 2) ;; reduce chance of runaway
(server:run *toppath*))
(db:all-db-sync *dbstruct-dbs*)
(thread-sleep! 30)
(http-transport:server-shutdown port)))
((and *server-run*
(> (+ last-access server-timeout)
(current-seconds)))
(if (common:low-noise-print 120 "server continuing")
(debug:print-info 0 *default-log-port* "Server continuing, seconds since last db access: " (- (current-seconds) last-access))
(let ((curr-time (current-seconds)))
(handle-exceptions
|