| ︙ | | |
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
|
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
|
-
+
-
+
|
;;======================================================================
;;======================================================================
;; S E R V E R
;;======================================================================
(define (rmt:kill-server run-id)
(rmt:send-receive 'kill-server run-id (list run-id)))
(rmt:send-receive 'kill-server #f (list run-id)))
(define (rmt:start-server run-id)
(rmt:send-receive 'start-server 0 (list run-id)))
(rmt:send-receive 'start-server #f (list run-id)))
(define (rmt:get-server-info apath dbname)
(rmt:send-receive 'get-server-info #f (list apath dbname)))
;;======================================================================
;; M I S C
;;======================================================================
|
| ︙ | | |
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
|
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
|
-
-
+
+
+
+
|
,dbname)))
(define (rmt:get-count-servers remdat apath)
(remotedat-conns remdat) ;; just checking types
(rmt:open-main-connection remdat apath) ;; we need a channel to main.db
(rmt:send-receive-real remdat apath ;; params: host port servkey pid ipaddr dbpath
(db:run-id->dbname #f)
'get-count-servers `(,apath
)))
'get-count-servers `(,apath)))
(define (rmt:get-servers-info apath)
(rmt:send-receive 'get-servers-info #f `(,apath)))
(define (rmt:deregister-server remdat apath iface port server-key dbname)
(remotedat-conns remdat) ;; just checking types
(rmt:open-main-connection remdat apath) ;; we need a channel to main.db
(rmt:send-receive-real remdat apath ;; params: host port servkey pid ipaddr dbpath
(db:run-id->dbname #f)
'deregister-server `(,iface
|
| ︙ | | |
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
|
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
|
-
+
+
+
+
+
+
+
+
+
+
|
(let* ((remdat *remotedat*)
(server-start-time (current-seconds))
(pkts-dir (get-pkts-dir))
(server-key (rmt:get-signature)) ;; This servers key
(is-main (equal? (args:get-arg "-db") ".db/main.db"))
(last-access 0)
(server-timeout (server:expiration-timeout)))
(server-timeout (server:expiration-timeout))
(shutdown-server-sequence (lambda (port)
(set! *unclean-shutdown* #f)
(debug:print-info 0 *default-log-port* "Starting to shutdown the server. pid="(current-process-id))
(rmt:server-shutdown)
(portlogger:open-run-close portlogger:set-port port "released")
(exit)))
(timed-out? (lambda ()
(<= (+ last-access server-timeout)
(current-seconds)))))
;; main and run db servers have both got wait logic (could/should merge it)
(if is-main
(rmt:wait-for-server pkts-dir dbname server-key)
(rmt:wait-for-stable-interface))
;; this is our forever loop
(let* ((iface (servdat-host *server-info*))
(port (servdat-port *server-info*)))
|
| ︙ | | |
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
|
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
|
+
+
+
+
+
+
-
+
-
-
+
-
-
+
-
-
|
(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
((not *server-run*)
(debug:print-info 0 *default-log-port* "*server-run* set to #f. Shutting down.")
(shutdown-server-sequence port))
((timed-out?)
(debug:print-info 0 *default-log-port* "Server timed out. seconds since last db access: " (- (current-seconds) last-access))
(shutdown-server-sequence port))
((and *server-run*
(> (+ last-access server-timeout)
(not (timed-out?))
(current-seconds))
(if is-main
(debug:print-info 0 *default-log-port* "Starting to shutdown the server. pid="(current-process-id))
(rmt:server-shutdown)
(portlogger:open-run-close portlogger:set-port port "released")
(exit)
|
| ︙ | | |