Megatest

Check-in [196200bc41]
Login
Overview
Comment:Added code to remove server files when stop-the-train is found.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.70
Files: files | file ages | folders
SHA1: 196200bc41a6e654979c29310ab9cb9842c599b9
User & Date: mmgraham on 2023-07-20 16:11:47
Other Links: branch diff | manifest | tags
Context
2023-07-20
16:12
Changed version to v1.7015 check-in: 3152edd3b0 user: mmgraham tags: v1.70, v1.7015
16:11
Added code to remove server files when stop-the-train is found. check-in: 196200bc41 user: mmgraham tags: v1.70
2023-07-17
19:26
made the ERROR: dat= message a level 2, to avoid test failures check-in: acce1f234a user: mmgraham tags: v1.70
Changes

Modified common.scm from [760479d289] to [0a8c20bd40].

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
57
58
59
60

(declare (unit common))
(declare (uses commonmod))
(import commonmod)

(include "common_records.scm")


;; (require-library margs)
;; (include "margs.scm")

;; (define old-exit exit)
;; 
;; (define (exit . code)
;;   (if (null? code)
;;       (old-exit)
;;       (old-exit code)))

(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")

					(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)







|
|
<
|
<
<
<
<
<
<








>







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

(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*"))))

    (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"))
					(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)