36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
|
(use posix-extras pathname-expand files)
(import commonmod
debugprint
rmtmod
(prefix mtargs args:))
(include "common_records.scm")
|
|
>
>
>
<
>
|
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
|
(use posix-extras pathname-expand files)
(import commonmod
debugprint
rmtmod
(prefix mtargs args:))
(define (remove-server-files directory-path)
(let ((files (glob (string-append directory-path "/server*"))))
(for-each delete-file* files)))
(include "common_records.scm")
(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")))
(let* ((msg (conc "ERROR: found file "*toppath*"/stop-the-train, exiting immediately")))
;; yes, print to current-output-port AND *default-log-port*, annoying but necessary I think
(print msg)
(remove-server-files (conc *toppath* "/logs"))
(debug:print 0 *default-log-port* msg)
(remove-files (conc *toppath* "/logs/server*"))
(remove-files (conc *toppath* "/.servinfo/*"))
(remove-files (conc *toppath* "/.mtdb/*lock"))
(exit 1)))
(thread-sleep! 5)
(loop))))))
|