Megatest

Check-in [de8d1d67ff]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:added code to remove logs/server and .servinfo files when stop-the-train is found
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.80 | v1.8015
Files: files | file ages | folders
SHA1: de8d1d67ffcf8b2e3c72f6819a9231499d5ef2f4
User & Date: mmgraham on 2023-07-21 18:45:24
Other Links: branch diff | manifest | tags
Context
2023-07-25
17:02
corrected number of run dbs and used num-run-dbs parameter check-in: 5fcf2ed73e user: mmgraham tags: v1.80
2023-07-21
18:45
added code to remove logs/server and .servinfo files when stop-the-train is found check-in: de8d1d67ff user: mmgraham tags: v1.80, v1.8015
2023-07-19
22:44
updated megatest version to 1.8015 check-in: 5f9c37278f user: mmgraham tags: v1.80
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified common.scm from [49557c29a9] to [81f7ea3a51].

︙︙
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
68
69
70
71

(import commonmod
	debugprint
	rmtmod
	(prefix mtargs args:))

(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")))
				      (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)
					(debug:print 0 *default-log-port* msg)


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








|
|
<
|
<
<
<
<
<
<










>
>








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

(import commonmod
	debugprint
	rmtmod
	(prefix mtargs args:))

(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)
					(debug:print 0 *default-log-port* msg)
                                        (remove-files (conc *toppath* "/logs/server*"))
                                        (remove-files (conc *toppath* "/.servinfo/*"))
					(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)
︙︙

This page was generated in about 0.105s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00