32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
|
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
|
-
+
|
(include "db_records.scm")
(define (http-transport:make-server-url hostport)
(if (not hostport)
#f
(conc "http://" (car hostport) ":" (cadr hostport))))
(define *server-loop-heart-beat* (current-seconds))
(define *server-loop-heart-beat* (current-seconds))
(define *heartbeat-mutex* (make-mutex))
;;======================================================================
;; S E R V E R
;;======================================================================
;; Call this to start the actual server
|
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
|
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
|
+
-
-
+
+
-
+
|
(tasks:server-update-heartbeat tdb spid)
;; (if ;; (or (> numrunning 0) ;; stay alive for two days after last access
(mutex-lock! *heartbeat-mutex*)
(set! last-access *last-db-access*)
(mutex-unlock! *heartbeat-mutex*)
;; (debug:print 11 "last-access=" last-access ", server-timeout=" server-timeout)
(if (and *server-run*
(if (> (+ last-access server-timeout)
(current-seconds))
(debug:print-info 2 "Server continuing, seconds since last db access: " (- (current-seconds) last-access))
(debug:print-info 0 "Server continuing, seconds since last db access: " (- (current-seconds) last-access))
(loop 0))
(begin
(debug:print-info 0 "Starting to shutdown the server.")
;; need to delete only *my* server entry (future use)
(set! *time-to-exit* #t)
(open-run-close tasks:server-deregister-self tasks:open-db (get-host-name))
(thread-sleep! 1)
|