29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
|
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
|
-
-
+
+
-
+
+
+
|
(declare (unit common))
(declare (uses commonmod))
(import commonmod)
(include "common_records.scm")
(define (remove-server-files directory-path)
(let ((files (glob (string-append directory-path "/server*"))))
(define (remove-files filespec)
(let ((files (glob filespec)))
(for-each delete-file* files)))
(define (stop-the-train)
(thread-start! (make-thread (lambda ()
(let loop ()
(if (and *toppath*
(file-exists? (conc *toppath*"/stop-the-train")))
(begin
(debug:print 0 *default-log-port* "ERROR: found file "*toppath*"/stop-the-train, exiting immediately")
(remove-server-files (conc *toppath* "/logs"))
(remove-files (conc *toppath* "/logs/server*"))
(remove-files (conc *toppath* "/.servinfo/*"))
(remove-files (conc *toppath* "/.mtdb/*lock"))
(exit 1)))
(thread-sleep! 5)
(loop))))))
;; execute thunk, return value. If exception thrown, trap exception, return #f, and emit nonfatal condition note to *default-log-port* .
;; arguments - thunk, message
(define (common:fail-safe thunk warning-message-on-exception)
|
679
680
681
682
683
684
685
686
687
688
689
690
691
692
|
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
|
+
+
+
+
+
+
|
(if dat
dat
""))))
(define (common:alist-ref/default key alist default)
(or (alist-ref key alist) default))
;; The `common:low-noise-print` function is a utility that can be used to throttle the
;; frequency of certain operations. It does this by tracking the last time an operation was
;; performed and only allowing it again after a specified interval (`waitval`). This can be useful
;; for reducing noise in logs or limiting the rate of user notifications, among other use cases.
(define (common:low-noise-print waitval . keys)
(let* ((key (string-intersperse (map conc keys) "-" ))
(lasttime (hash-table-ref/default *common:denoise* key 0))
(currtime (current-seconds)))
(if (> (- currtime lasttime) waitval)
(begin
(hash-table-set! *common:denoise* key currtime)
|