Megatest

Check-in [b0a3cd70ab]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Converted portlogger to a module, adjusted Makefile accordingly
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65-multi-db
Files: files | file ages | folders
SHA1: b0a3cd70ab279e18883552db4a58982f84247294
User & Date: matt on 2019-02-02 07:55:39
Other Links: branch diff | manifest | tags
Context
2019-02-02
18:54
portlogger tweaks check-in: da6d7b6655 user: matt tags: v1.65-multi-db
07:55
Converted portlogger to a module, adjusted Makefile accordingly check-in: b0a3cd70ab user: matt tags: v1.65-multi-db
06:00
Updated portlogger to check on the port availability check-in: 60b0f467ff user: matt tags: v1.65-multi-db
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified Makefile from [8e9ef04054] to [7fc24d5f72].

︙
25
26
27
28
29
30
31
32

33
34
35

36
37
38
39
40
41
42

25
26
27
28
29
30
31

32
33
34

35
36
37
38
39
40
41
42








-
+


-
+








   ods.scm runconfig.scm server.scm configf.scm \
   db.scm keys.scm margs.scm megatest-version.scm \
   process.scm runs.scm tasks.scm tests.scm genexample.scm \
   http-transport.scm filedb.scm tdb.scm \
   client.scm mt.scm \
   ezsteps.scm lock-queue.scm sdb.scm \
   rmt.scm api.scm subrun.scm \
   portlogger.scm archive.scm env.scm diff-report.scm cgisetup/models/pgdb.scm 
   archive.scm env.scm diff-report.scm cgisetup/models/pgdb.scm 

# module source files
MSRCFILES = ftail.scm
MSRCFILES = ftail.scm portlogger.scm

# Eggs to install (straightforward ones)
EGGS=matchable readline apropos base64 regex-literals format regex-case test coops trace csv \
dot-locking posix-utils posix-extras directory-utils hostinfo tcp-server rpc csv-xml fmt \
json md5 awful http-client spiffy uri-common intarweb spiffy-request-vars \
spiffy-directory-listing ssax sxml-serializer sxml-modifications iup canvas-draw sqlite3
︙
69
70
71
72
73
74
75
76

77
78
79
80
81
82
83
84
85
86
87
88
89


90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120



121
122
123


124
125
126
127
128
129
130

69
70
71
72
73
74
75

76
77
78
79
80
81
82
83
84
85
86
87


88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108

109
110

111
112
113
114
115
116
117

118
119
120
121


122
123
124
125
126
127
128
129
130








-
+











-
-
+
+



















-


-







-
+
+
+

-
-
+
+








# ARCHSTR=$(shell bash -c "echo \$$MACHTYPE")

PNGFILES = $(shell cd docs/manual;ls *png)

#all : $(PREFIX)/bin/.$(ARCHSTR) mtest dboard mtut ndboard
all : $(PREFIX)/bin/.$(ARCHSTR) mtest dboard mtut

mtest: $(OFILES) readline-fix.scm megatest.o $(MOFILES) mofiles/ftail.o
mtest: $(OFILES) readline-fix.scm megatest.o $(MOFILES)
	csc $(CSCOPTS) $(OFILES) $(MOFILES) megatest.o -o mtest

showmtesthash:
	@echo $(MTESTHASH)

dboard : $(OFILES) $(GOFILES) dashboard.scm $(MOFILES)
	csc $(CSCOPTS) $(OFILES) dashboard.scm $(GOFILES) $(MOFILES) -o dboard

ndboard : newdashboard.scm $(OFILES) $(GOFILES)
	csc $(CSCOPTS) $(OFILES) $(GOFILES) newdashboard.scm -o ndboard

mtut: $(OFILES) megatest-fossil-hash.scm mtut.scm
	csc $(CSCOPTS) $(OFILES) mtut.scm -o mtut
mtut: $(OFILES) megatest-fossil-hash.scm mtut.scm $(MOFILES)
	csc $(CSCOPTS) $(OFILES) $(MOFILES) mtut.scm -o mtut

TCMTOBJS = \
	api.o \
	archive.o \
	cgisetup/models/pgdb.o \
	client.o \
	common.o \
	configf.o \
	db.o \
	env.o \
	http-transport.o \
	items.o \
	keys.o \
	launch.o \
	lock-queue.o \
	margs.o \
	mt.o \
	megatest-version.o \
	ods.o \
	portlogger.o \
	process.o \
	rmt.o \
	rpc-transport.o \
	runconfig.o \
	runs.o \
	server.o \
	tasks.o \
	tdb.o \
	tests.o \
	subrun.o \

 
#	rpc-transport.o \
#	portlogger.o \

tcmt : $(TCMTOBJS) tcmt.scm
	csc $(CSCOPTS) $(TCMTOBJS) tcmt.scm -o tcmt
tcmt : $(TCMTOBJS) tcmt.scm $(MOFILES)
	csc $(CSCOPTS) $(TCMTOBJS) $(MOFILES) tcmt.scm -o tcmt

# install documentation to $(PREFIX)/docs
# DOES NOT REBUILD DOCS
#
$(PREFIX)/share/docs/megatest_manual.html : docs/manual/megatest_manual.html
	mkdir -p $(PREFIX)/share/docs
	$(INSTALL) docs/manual/megatest_manual.html $(PREFIX)/share/docs/megatest_manual.html
︙
154
155
156
157
158
159
160



161
162
163
164
165
166
167
168
169
170
171





172
173
174
175
176
177
178

154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172


173
174
175
176
177
178
179
180
181
182
183
184








+
+
+









-
-
+
+
+
+
+








tests.o tasks.o dashboard-tasks.o : task_records.scm
runs.o : test_records.scm
megatest.o : megatest-fossil-hash.scm
rmt.scm client.scm common.scm configf.scm dashboard-guimonitor.scm dashboard-tests.scm dashboard.scm db.scm dcommon.scm ezsteps.scm fs-transport.scm http-transport.scm index-tree.scm items.scm keys.scm launch.scm megatest.scm monitor.scm mt.scm newdashboard.scm runconfig.scm runs.scm server.scm tdb.scm tests.scm tree.scm : common_records.scm
common_records.scm : altdb.scm
vg.o dashboard.o : vg_records.scm
dcommon.o : run_records.scm

# module deps
http-transport.o : mofiles/portlogger.o
# Temporary while transitioning to new routine
# runs.o : run-tests-queue-classic.scm  run-tests-queue-new.scm

megatest-fossil-hash.scm : $(SRCFILES) megatest.scm *_records.scm
	echo "(define megatest-fossil-hash \"$(MTESTHASH)\")" > megatest-fossil-hash.new
	if ! diff -q megatest-fossil-hash.new megatest-fossil-hash.scm ; then echo copying .new to .scm;cp -f megatest-fossil-hash.new megatest-fossil-hash.scm;fi

$(OFILES) $(GOFILES) : common_records.scm 

%.o : %.scm $(MOFILES)
	csc $(CSCOPTS) -c $< $(MOFILES)
# %.o : %.scm $(MOFILES)
#	csc $(CSCOPTS) -c $< $(MOFILES)

%.o : %.scm
	csc $(CSCOPTS) -c $<

$(PREFIX)/bin/.$(ARCHSTR)/mtest : mtest utils/mk_wrapper
	@echo Installing to PREFIX=$(PREFIX)
	$(INSTALL) mtest $(PREFIX)/bin/.$(ARCHSTR)/mtest
	utils/mk_wrapper $(PREFIX) mtest $(PREFIX)/bin/megatest
	chmod a+x $(PREFIX)/bin/megatest
︙
301
302
303
304
305
306
307
308

309
310
311
312
313
314
315

307
308
309
310
311
312
313

314
315
316
317
318
319
320
321








-
+








	mkdir -p ext-tests
	cd ext-tests;fossil open --nested $(MTQA_FOSSIL)

$(MTQA_FOSSIL) :
	fossil clone https://www.kiatoa.com/fossils/megatest_qa $(MTQA_FOSSIL)

clean : 
	rm -f $(OFILES) $(GOFILES) $(MOFILES) $(TCMTOBJS) $(PREFIX)/megatest $(PREFIX)/dashboard mtest mtutil dboard dboard.o megatest.o dashboard.o megatest-fossil-hash.* altdb.scm mofiles/*.o vg.o
	rm -f $(OFILES) $(GOFILES) $(MOFILES) $(TCMTOBJS) $(PREFIX)/megatest $(PREFIX)/dashboard mtest mtutil dboard dboard.o megatest.o dashboard.o megatest-fossil-hash.* altdb.scm mofiles/*.o vg.o *import.scm

#======================================================================
# Make the records files
#======================================================================

# vg_records.scm : records.sh
#	./records.sh
︙
400
401
402
403
404
405
406
407
408


409
410
411
412
413
414
415

406
407
408
409
410
411
412


413
414
415
416
417
418
419
420
421








-
-
+
+








	if  csi -ne '(use mysql-client)';then \
           echo "(use mysql-client)(hash-table-set! *available-db* 'mysql #t)" >> altdb.scm; \
	fi
	if csi -ne '(use postgresql)';then \
	   echo "(use postgresql)(hash-table-set! *available-db* 'postgresql #t)" >> altdb.scm;\
	fi

portlogger-example : portlogger-example.scm api.o archive.o client.o common.o configf.o dashboard-tests.o dashboard-context-menu.o db.o dcommon.o ezsteps.o filedb.o genexample.o gutils.o http-transport.o items.o keys.o launch.o lock-queue.o margs.o megatest-version.o mt.o ods.o portlogger.o process.o rmt.o rpc-transport.o runconfig.o runs.o sdb.o server.o synchash.o tasks.o tdb.o tests.o tree.o
	csc $(CSCOPTS) portlogger-example.scm api.o archive.o client.o common.o configf.o dashboard-tests.o dashboard-context-menu.o db.o dcommon.o ezsteps.o filedb.o genexample.o gutils.o http-transport.o items.o keys.o launch.o lock-queue.o margs.o megatest-version.o mt.o ods.o portlogger.o process.o rmt.o rpc-transport.o runconfig.o runs.o sdb.o server.o synchash.o tasks.o tdb.o tests.o tree.o
portlogger-example : portlogger-example.scm api.o archive.o client.o common.o configf.o dashboard-tests.o dashboard-context-menu.o db.o dcommon.o ezsteps.o filedb.o genexample.o gutils.o http-transport.o items.o keys.o launch.o lock-queue.o margs.o megatest-version.o mt.o ods.o portlogger.o process.o rmt.o runconfig.o runs.o sdb.o server.o synchash.o tasks.o tdb.o tests.o tree.o
	csc $(CSCOPTS) portlogger-example.scm api.o archive.o client.o common.o configf.o dashboard-tests.o dashboard-context-menu.o db.o dcommon.o ezsteps.o filedb.o genexample.o gutils.o http-transport.o items.o keys.o launch.o lock-queue.o margs.o megatest-version.o mt.o ods.o portlogger.o process.o rmt.o  runconfig.o runs.o sdb.o server.o synchash.o tasks.o tdb.o tests.o tree.o

# create a pdf dot graphviz diagram from notations in rmt.scm
rmt.pdf : rmt.scm
	grep ';;DOT' rmt.scm | sed -e 's/.*;;DOT //' > rmt.dot;dot -Tpdf rmt.dot -o rmt.pdf

buildmanual:
	cd docs/manual && make
︙

Modified http-transport.scm from [da311848d8] to [b6b8ef7c43].

︙
38
39
40
41
42
43
44





45
46
47
48
49
50
51

38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56








+
+
+
+
+








(declare (uses portlogger))
(declare (uses rmt))

(include "common_records.scm")
(include "db_records.scm")
(include "js-path.scm")

(import portlogger)
(portlogger:set-default-log-port! *default-log-port*)
(portlogger:set-configdat! *configdat*)
(portlogger:set-printers! debug:print debug:print-error)

(require-library stml)
(define (http-transport:make-server-url hostport)
  (if (not hostport)
      #f
      (conc "http://" (car hostport) ":" (cadr hostport))))

(define *server-loop-heart-beat* (current-seconds))
︙

Modified megatest.scm from [cecad5eaf2] to [35ba0a4899].

︙
51
52
53
54
55
56
57


58
59
60
61
62
63
64

51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66








+
+








(declare (uses mt))
(declare (uses api))
(declare (uses tasks)) ;; only used for debugging.
(declare (uses env))
(declare (uses diff-report))
(declare (uses ftail))
(import ftail)
(declare (uses portlogger))
(import portlogger)

(define *db* #f) ;; this is only for the repl, do not use in general!!!!

(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "run_records.scm")
︙

Modified portlogger.scm from [6475e2ad5b] to [9dcb9ddb36].

︙
13
14
15
16
17
18
19

20
21
22






















23
24

25
26
27
28
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
61
62
63

64
65
66
67
68
69
70
71

72
73
74
75
76
77
78

13
14
15
16
17
18
19
20



21
22
23
24
25
26
27
28
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
61
62


63
64
65
66
67
68
69

70
71








72

73


74
75
76
77
78
79
80
81
82
83
84

85
86
87
88
89
90
91
92

93
94
95
96
97
98
99
100








+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+
-
-



+
+
+

+
+
+
+
+
+
+
+
+
+

-
-
+
+





-
+

-
-
-
-
-
-
-
-

-
+
-
-
+










-
+







-
+








;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
;;

(declare (unit portlogger))
(require-extension (srfi 18) extras tcp s11n)

(use sqlite3 srfi-1 posix srfi-69 hostinfo dot-locking z3 regex)

(module
 portlogger
 (portlogger:set-configdat!
  portlogger:set-printers!
  portlogger:set-default-log-port!
  portlogger:open-db
  portlogger:open-run-close
  portlogger:take-port
  portlogger:get-prev-used-port
  portlogger:find-port
  portlogger:set-port
  portlogger:release-port
  portlogger:set-failed
  portlogger:is-port-in-use
  portlogger:main
)
 
(import scheme posix chicken data-structures)

(require-extension (srfi 18) extras tcp s11n)
(import srfi-1 posix srfi-69 hostinfo dot-locking z3 regex)
(import (prefix sqlite3 sqlite3:))

(import (prefix mtconfigf configf:))
(declare (unit portlogger))
(declare (uses db))

;; lsof -i

(define *configdat* #f)
(define (portlogger:set-configdat! cfgdat)
  (set! *configdat* cfgdat))

(define (debug:print . params)
  (apply print params))
(define debug:print-error debug:print)
(define (portlogger:set-printers! pdebug pdebugerr)
  (set! debug:print pdebug)
  (set! debug:print-error pdebugerr))
(define *default-log-port* (current-error-port))
(define (portlogger:set-default-log-port! port)
  (set! *default-log-port* port))

(define (portlogger:open-db fname)
  (let* ((avail    (tasks:wait-on-journal fname 5 remove: #t)) ;; wait up to about 10 seconds for the journal to go away
	 (exists   (common:file-exists? fname))
  (let* ((avail    #t) ;; for now - assume wait on journal not needed (tasks:wait-on-journal fname 5 remove: #t)) ;; wait up to about 10 seconds for the journal to go away
	 (exists   (file-exists? fname))
	 (db       (if avail 
		       (sqlite3:open-database fname)
		       (begin
			 (system (conc "rm -f " fname))
			 (sqlite3:open-database fname))))
	 (handler  (make-busy-timeout 136000))
	 (handler  (sqlite3:make-busy-timeout 136000))
	 (canwrite (file-write-access? fname)))
	 ;; (db-init  (lambda ()
	 ;;             (sqlite3:execute 
	 ;;              db
	 ;;              "CREATE TABLE IF NOT EXISTS ports (
         ;;                 port INTEGER PRIMARY KEY,
         ;;                 state TEXT DEFAULT 'not-used',
         ;;                 fail_count INTEGER DEFAULT 0,
         ;;                 update_time TIMESTAMP DEFAULT (strftime('%s','now')) );"))))
    (sqlite3:set-busy-handler! db handler)
    (db:set-sync db) ;; (sqlite3:execute db "PRAGMA synchronous = 0;")
    (sqlite3:execute db "PRAGMA synchronous = 0;")
    ;; (if (not exists) ;; needed with IF NOT EXISTS?
    (sqlite3:execute 
        (sqlite3:execute 
     db
     "CREATE TABLE IF NOT EXISTS ports (
            port INTEGER PRIMARY KEY,
            state TEXT DEFAULT 'not-used',
            fail_count INTEGER DEFAULT 0,
            update_time TIMESTAMP DEFAULT (strftime('%s','now')) );")
    db))

(define (portlogger:open-run-close proc . params)
  (let* ((fname  (conc "/tmp/." (current-user-name) "-portlogger.db"))
	 (avail  (tasks:wait-on-journal fname 10))) ;; wait up to about 10 seconds for the journal to go away
	 (avail  #t)) ;; (tasks:wait-on-journal fname 10))) ;; wait up to about 10 seconds for the journal to go away
    (handle-exceptions
     exn
     (begin
       ;; (release-dot-lock fname)
       (debug:print-error 0 *default-log-port* "portlogger:open-run-close failed. " proc " " params)
       (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
       (debug:print 5 *default-log-port* "exn=" (condition->list exn))
       (if (common:file-exists? fname)(delete-file fname)) ;; brutally get rid of it
       (if (file-exists? fname)(delete-file fname)) ;; brutally get rid of it
       (print-call-chain (current-error-port)))
     (let* (;; (lock   (obtain-dot-lock fname 2 9 10))
	    (db     (portlogger:open-db fname))
	    (res    (apply proc db params)))
       (sqlite3:finalize! db)
       ;; (release-dot-lock fname)
       res))))
︙
205
206
207
208
209
210
211


227
228
229
230
231
232
233
234








+

					   state)
		      state))
	     ((failed)(portlogger:set-failed db (string->number (cadr args))) 'failed)))))
    (sqlite3:finalize! db)
    result))
     
;; (print (apply portlogger:main (cdr (argv))))
)

Added utils/get-procedures.sh version [aa92973588]. 







1
2
3
4
5

+
+
+
+
+

#!/bin/bash

fname=$1

grep '(define (' $fname | tr '()' '  '|awk '{print $2}'













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