264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
|
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
|
-
-
+
+
|
(th2 (make-thread time-out "time out")))
(thread-start! th1)
(thread-start! th2)
(thread-join! th1)
(thread-terminate! th2)
(debug:print-info 11 *default-log-port* "got res=" res)
(if (vector? res)
(if (vector-ref res 0)
res
(if (vector-ref res 0) ;; this is the first flag or the second flag?
res ;; this is the *inner* vector? seriously? why?
(if (debug:debug-mode 11)
(begin ;; note: this code also called in nmsg-transport - consider consolidating it
(debug:print-error 11 *default-log-port* "error occured at server, info=" (vector-ref res 2))
(debug:print 11 *default-log-port* " client call chain:")
(print-call-chain (current-error-port))
(debug:print 11 *default-log-port* " server call chain:")
(pp (vector-ref res 1) (current-error-port))
|
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
|
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
|
-
+
+
+
+
|
(set! last-access *db-last-access*)
(mutex-unlock! *heartbeat-mutex*)
(if (common:low-noise-print 120 (conc "server running on " iface ":" port))
(begin
(debug:print 0 *default-log-port* "SERVER STARTED: " iface ":" port " AT " (current-seconds))
(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))
(adjusted-timeout (if (> hrs-since-start 1)
(- server-timeout (inexact->exact (round (* hrs-since-start 60)))) ;; subtract 60 seconds per hour
server-timeout)))
(if (common:low-noise-print 120 "server timeout")
(debug:print-info 0 *default-log-port* "Adjusted server timeout: " adjusted-timeout))
(cond
|