Megatest

Check-in [b7a7d741be]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Merged some portlogger and module refactoring changes.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65-real-new-runs-view
Files: files | file ages | folders
SHA1: b7a7d741be32ee155fc2922cab5cc4ab47c39ad7
User & Date: matt on 2021-02-25 22:36:48
Other Links: branch diff | manifest | tags
Context
2021-02-25
22:47
Merged in wip2. Leaf check-in: 05a89e44c8 user: matt tags: v1.65-real-new-runs-view
22:36
Merged some portlogger and module refactoring changes. check-in: b7a7d741be user: matt tags: v1.65-real-new-runs-view
11:24
Added multi-node cherrypicker check-in: d85f01faff user: mrwellan tags: v1.65-real-new-runs-view
2021-02-24
23:28
fixed portlogger - there was installed module colliding. moved few more things around and getting close Closed-Leaf check-in: 83714e16c5 user: matt tags: v1.65-real-new-runs-view-wip2
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified Makefile from [5068e78464] to [c3e28f800e].

︙︙
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

CSCOPTS=
INSTALL=install
SRCFILES = common.scm items.scm launch.scm runconfig.scm	\
           server.scm configf.scm db.scm margs.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

# module source files
MSRCFILES = dbmod.scm servermod.scm apimod.scm commonmod.scm rmtmod.scm ods.scm configfmod.scm
MOFILES = $(addprefix mofiles/,$(MSRCFILES:%.scm=%.o))
MOIMPFILES = $(MSRCFILES:%.scm=%.import.o)
# ftail.scm rmtmod.scm commonmod.scm removed
# MSRCFILES = ducttape-lib.scm pkts.scm stml2.scm cookie.scm mutils.scm	\
#             mtargs.scm commonmod.scm dbmod.scm adjutant.scm ulex.scm	\
#             rmtmod.scm apimod.scm

DMSRCFILES = dcommonmod.scm
DMOFILES = $(addprefix mofiles/,$(DMSRCFILES:%.scm=%.o))
DMOIMPFILES = $(DMSRCFILES:%.scm=%.import.o)

GUISRCF = dashboard-context-menu.scm dashboard-tests.scm		\
          dashboard-guimonitor.scm gutils.scm dcommon.scm tree.scm	\
          vg.scm

OFILES   = $(SRCFILES:%.scm=%.o)
GOFILES  = $(GUISRCF:%.scm=%.o)


%.import.o : %.import.scm mofiles/%.o
	csc $(CSCOPTS) -unit $*.import -c $*.import.scm -o $*.import.o

# I'm not sure the cp is a good idea, changed a lot of things and it may not have been necessary...
# mofiles/%.o  %.import.scm : %.scm megatest-fossil-hash.scm
#	@[ -e mofiles ] || mkdir -p mofiles
#	csc $(CSCOPTS) -I mofiles -I $* -J -c $< -o $*.o
#	cp $*.o mofiles/$*.o


# ensure import.scm is touched after the .o is made
#
mofiles/%.o %.import.scm : %.scm
	csc $(CSCOPTS) -J -c $< -o mofiles/$*.o
	@touch $*.import.scm

ADTLSCR=mt_laststep mt_runstep mt_ezstep
HELPERS=$(addprefix $(PREFIX)/bin/,$(ADTLSCR))
DEPLOYHELPERS=$(addprefix deploytarg/,$(ADTLSCR))
MTESTHASH=$(shell fossil info|grep checkout:| awk '{print $$2}')









|



|


















<













|








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

CSCOPTS=
INSTALL=install
SRCFILES = common.scm items.scm launch.scm runconfig.scm	\
           server.scm configf.scm db.scm margs.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 archive.scm env.scm		\
           diff-report.scm cgisetup/models/pgdb.scm

# module source files
MSRCFILES = dbmod.scm servermod.scm apimod.scm commonmod.scm rmtmod.scm ods.scm configfmod.scm transport.scm portlogger.scm
MOFILES = $(addprefix mofiles/,$(MSRCFILES:%.scm=%.o))
MOIMPFILES = $(MSRCFILES:%.scm=%.import.o)
# ftail.scm rmtmod.scm commonmod.scm removed
# MSRCFILES = ducttape-lib.scm pkts.scm stml2.scm cookie.scm mutils.scm	\
#             mtargs.scm commonmod.scm dbmod.scm adjutant.scm ulex.scm	\
#             rmtmod.scm apimod.scm

DMSRCFILES = dcommonmod.scm
DMOFILES = $(addprefix mofiles/,$(DMSRCFILES:%.scm=%.o))
DMOIMPFILES = $(DMSRCFILES:%.scm=%.import.o)

GUISRCF = dashboard-context-menu.scm dashboard-tests.scm		\
          dashboard-guimonitor.scm gutils.scm dcommon.scm tree.scm	\
          vg.scm

OFILES   = $(SRCFILES:%.scm=%.o)
GOFILES  = $(GUISRCF:%.scm=%.o)


%.import.o : %.import.scm mofiles/%.o
	csc $(CSCOPTS) -unit $*.import -c $*.import.scm -o $*.import.o

# I'm not sure the cp is a good idea, changed a lot of things and it may not have been necessary...
# mofiles/%.o  %.import.scm : %.scm megatest-fossil-hash.scm
#	@[ -e mofiles ] || mkdir -p mofiles
#	csc $(CSCOPTS) -I mofiles -I $* -J -c $< -o $*.o
#	cp $*.o mofiles/$*.o


# ensure import.scm is touched after the .o is made
#
mofiles/%.o %.import.scm : %.scm
	csc $(CSCOPTS) -I mofiles -I $* -J -c $< -o mofiles/$*.o
	@touch $*.import.scm

ADTLSCR=mt_laststep mt_runstep mt_ezstep
HELPERS=$(addprefix $(PREFIX)/bin/,$(ADTLSCR))
DEPLOYHELPERS=$(addprefix deploytarg/,$(ADTLSCR))
MTESTHASH=$(shell fossil info|grep checkout:| awk '{print $$2}')
︙︙
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127

	env.o \
	http-transport.o \
	items.o \
	launch.o \
	lock-queue.o \
	margs.o \
	mt.o \
	portlogger.o \
	process.o \
	rmt.o \
	runconfig.o \
	runs.o \
	server.o \
	tasks.o \
	tdb.o \








<








112
113
114
115
116
117
118

119
120
121
122
123
124
125

	env.o \
	http-transport.o \
	items.o \
	launch.o \
	lock-queue.o \
	margs.o \
	mt.o \

	process.o \
	rmt.o \
	runconfig.o \
	runs.o \
	server.o \
	tasks.o \
	tdb.o \
︙︙
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507

	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 launch.o lock-queue.o margs.o mt.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 launch.o lock-queue.o margs.o mt.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








|
|








490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505

	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 launch.o lock-queue.o margs.o mt.o mofiles/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 launch.o lock-queue.o margs.o mt.o mofiles/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 build.inc from [3ca41ba17c] to [16569e7315]. 

1
2
3
4
5

6
7
8
9

10
11
12
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
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

# To regenerate this file do:
#   (cd utils/;ck52 csc gendeps.scm) && ./utils/gendeps allunits *scm
#   cp allunits.inc build.inc
#


tree.o : mofiles/commonmod.o
tests.o : mofiles/commonmod.o
tdb.o : mofiles/commonmod.o
tcmt.o : mofiles/commonmod.o

tasks.o : mofiles/commonmod.o
subrun.o : mofiles/commonmod.o
mofiles/servermod.o : mofiles/commonmod.o
server.o : mofiles/commonmod.o
runs.o : mofiles/commonmod.o
runconfig.o : mofiles/commonmod.o
mofiles/rmtmod.o : mofiles/commonmod.o
rmt.o : mofiles/commonmod.o
process.o : mofiles/commonmod.o
portlogger.o : mofiles/commonmod.o
mofiles/ods.o : mofiles/commonmod.o

newdashboard.o : mofiles/commonmod.o

mtut.o : mofiles/commonmod.o
mt.o : mofiles/commonmod.o
megatest.o : mofiles/commonmod.o
lock-queue.o : mofiles/commonmod.o
launch.o : mofiles/commonmod.o
items.o : mofiles/commonmod.o
index-tree.o : mofiles/commonmod.o
http-transport.o : mofiles/commonmod.o
genexample.o : mofiles/commonmod.o
ezsteps.o : mofiles/commonmod.o
env.o : mofiles/commonmod.o
diff-report.o : mofiles/commonmod.o
mofiles/dcommonmod.o : mofiles/commonmod.o
dcommon.o : mofiles/commonmod.o
mofiles/dbmod.o : mofiles/commonmod.o
db.o : mofiles/commonmod.o
dashboard.o : mofiles/commonmod.o
dashboard-tests.o : mofiles/commonmod.o
dashboard-guimonitor.o : mofiles/commonmod.o
dashboard-context-menu.o : mofiles/commonmod.o
mofiles/configfmod.o : mofiles/commonmod.o
configf.o : mofiles/commonmod.o
common.o : mofiles/commonmod.o
client.o : mofiles/commonmod.o
archive.o : mofiles/commonmod.o
mofiles/apimod.o : mofiles/commonmod.o
api.o : mofiles/commonmod.o
tree.o : mofiles/dbmod.o
tests.o : mofiles/dbmod.o
tdb.o : mofiles/dbmod.o
tasks.o : mofiles/dbmod.o
synchash.o : mofiles/dbmod.o
subrun.o : mofiles/dbmod.o
mofiles/servermod.o : mofiles/dbmod.o
server.o : mofiles/dbmod.o
runs.o : mofiles/dbmod.o
mofiles/rmtmod.o : mofiles/dbmod.o
rmt.o : mofiles/dbmod.o
portlogger.o : mofiles/dbmod.o
newdashboard.o : mofiles/dbmod.o
mt.o : mofiles/dbmod.o
megatest.o : mofiles/dbmod.o
launch.o : mofiles/dbmod.o

http-transport.o : mofiles/dbmod.o
ezsteps.o : mofiles/dbmod.o
dcommon.o : mofiles/dbmod.o
db.o : mofiles/dbmod.o
dashboard.o : mofiles/dbmod.o
dashboard-tests.o : mofiles/dbmod.o
dashboard-guimonitor.o : mofiles/dbmod.o
dashboard-context-menu.o : mofiles/dbmod.o
common.o : mofiles/dbmod.o
client.o : mofiles/dbmod.o
archive.o : mofiles/dbmod.o
api.o : mofiles/dbmod.o
dcommon.o : mofiles/dcommonmod.o
dashboard.o : mofiles/dcommonmod.o
tests.o : mofiles/servermod.o
server.o : mofiles/servermod.o
runs.o : mofiles/servermod.o
rmt.o : mofiles/servermod.o
megatest.o : mofiles/servermod.o
http-transport.o : mofiles/servermod.o
dcommon.o : mofiles/servermod.o
db.o : mofiles/servermod.o
dashboard.o : mofiles/servermod.o
common.o : mofiles/servermod.o
client.o : mofiles/servermod.o
tests.o : mofiles/configfmod.o

tasks.o : mofiles/configfmod.o
subrun.o : mofiles/configfmod.o
mofiles/servermod.o : mofiles/configfmod.o
server.o : mofiles/configfmod.o
runs.o : mofiles/configfmod.o
rmt.o : mofiles/configfmod.o
portlogger.o : mofiles/configfmod.o
newdashboard.o : mofiles/configfmod.o


mtut.o : mofiles/configfmod.o
mtexec.o : mofiles/configfmod.o
mt.o : mofiles/configfmod.o
megatest.o : mofiles/configfmod.o



launch.o : mofiles/configfmod.o
items.o : mofiles/configfmod.o
http-transport.o : mofiles/configfmod.o
ezsteps.o : mofiles/configfmod.o
mofiles/dcommonmod.o : mofiles/configfmod.o
dcommon.o : mofiles/configfmod.o
mofiles/dbmod.o : mofiles/configfmod.o

db.o : mofiles/configfmod.o
dashboard.o : mofiles/configfmod.o
dashboard-tests.o : mofiles/configfmod.o
dashboard-context-menu.o : mofiles/configfmod.o
configf.o : mofiles/configfmod.o
common.o : mofiles/configfmod.o

archive.o : mofiles/configfmod.o
tdb.o : mofiles/ods.o
megatest.o : mofiles/ods.o
mofiles/dbmod.o : mofiles/ods.o
mofiles/rmtmod.o : mofiles/apimod.o
rmt.o : mofiles/apimod.o
megatest.o : mofiles/apimod.o
dashboard.o : mofiles/apimod.o
api.o : mofiles/apimod.o
rmt.o : mofiles/rmtmod.o
megatest.o : mofiles/rmtmod.o






>
|
|
|
|
>
|
|
|
|
|
|
|
|
|
|
|
>
|
>
|
|
|
|
|
|
|
|
|
|
|
|
|

<
|
|
<
<
<
<
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
<
|
|
<
|
|

>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
|
|
|
|
|
|
|

>
>
|
|
|
|
>
>
>
|
|
|
|
|
|
|
>
|
|
|
|
|
|
>
|
|
|
|
<
|
|
|
|
|
|

1
2
3
4
5
6
7
8
9
10
11
12
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
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
131

# To regenerate this file do:
#   (cd utils/;ck52 csc gendeps.scm) && ./utils/gendeps allunits *scm
#   cp allunits.inc build.inc
#

api.o : mofiles/apimod.o
api.o : mofiles/commonmod.o
api.o : mofiles/dbmod.o
archive.o : mofiles/commonmod.o
archive.o : mofiles/configfmod.o
archive.o : mofiles/dbmod.o
client.o : mofiles/commonmod.o
client.o : mofiles/dbmod.o
client.o : mofiles/servermod.o
common.o : mofiles/commonmod.o
common.o : mofiles/configfmod.o
common.o : mofiles/dbmod.o
common.o : mofiles/servermod.o
configf.o : mofiles/commonmod.o
configf.o : mofiles/configfmod.o
dashboard-context-menu.o : mofiles/commonmod.o
dashboard-context-menu.o : mofiles/configfmod.o
dashboard-context-menu.o : mofiles/dbmod.o
dashboard-guimonitor.o : mofiles/commonmod.o
dashboard-guimonitor.o : mofiles/dbmod.o
dashboard-tests.o : mofiles/commonmod.o
dashboard-tests.o : mofiles/configfmod.o
dashboard-tests.o : mofiles/dbmod.o
dashboard.o : mofiles/apimod.o
dashboard.o : mofiles/commonmod.o
dashboard.o : mofiles/configfmod.o
dashboard.o : mofiles/dbmod.o
dashboard.o : mofiles/dcommonmod.o
dashboard.o : mofiles/servermod.o
db.o : mofiles/commonmod.o
db.o : mofiles/configfmod.o
db.o : mofiles/dbmod.o
db.o : mofiles/servermod.o
dcommon.o : mofiles/commonmod.o

dcommon.o : mofiles/configfmod.o
dcommon.o : mofiles/dbmod.o




dcommon.o : mofiles/dcommonmod.o
dcommon.o : mofiles/servermod.o
diff-report.o : mofiles/commonmod.o
env.o : mofiles/commonmod.o
ezsteps.o : mofiles/commonmod.o
ezsteps.o : mofiles/configfmod.o
ezsteps.o : mofiles/dbmod.o
genexample.o : mofiles/commonmod.o
http-transport.o : mofiles/commonmod.o
http-transport.o : mofiles/configfmod.o
http-transport.o : mofiles/dbmod.o
http-transport.o : mofiles/portlogger.o
http-transport.o : mofiles/servermod.o
http-transport.o : mofiles/transport.o
index-tree.o : mofiles/commonmod.o

items.o : mofiles/commonmod.o
items.o : mofiles/configfmod.o

launch.o : mofiles/commonmod.o
launch.o : mofiles/configfmod.o
launch.o : mofiles/dbmod.o
lock-queue.o : mofiles/commonmod.o
megatest.o : mofiles/apimod.o
megatest.o : mofiles/commonmod.o
megatest.o : mofiles/configfmod.o
megatest.o : mofiles/dbmod.o
megatest.o : mofiles/ods.o
megatest.o : mofiles/rmtmod.o
megatest.o : mofiles/servermod.o
mofiles/apimod.o : mofiles/commonmod.o
mofiles/configfmod.o : mofiles/commonmod.o
mofiles/dbmod.o : mofiles/commonmod.o
mofiles/dbmod.o : mofiles/configfmod.o
mofiles/dbmod.o : mofiles/ods.o
mofiles/dcommonmod.o : mofiles/commonmod.o
mofiles/dcommonmod.o : mofiles/configfmod.o
mofiles/ods.o : mofiles/commonmod.o
mofiles/portlogger.o : mofiles/commonmod.o
mofiles/portlogger.o : mofiles/configfmod.o
mofiles/portlogger.o : mofiles/dbmod.o
mofiles/rmtmod.o : mofiles/apimod.o
mofiles/rmtmod.o : mofiles/commonmod.o
mofiles/rmtmod.o : mofiles/dbmod.o
mofiles/servermod.o : mofiles/commonmod.o
mofiles/servermod.o : mofiles/configfmod.o
mofiles/servermod.o : mofiles/dbmod.o
mofiles/transport.o : mofiles/commonmod.o
mofiles/transport.o : mofiles/configfmod.o
mofiles/transport.o : mofiles/portlogger.o
mt.o : mofiles/commonmod.o
mt.o : mofiles/configfmod.o
mt.o : mofiles/dbmod.o
mtexec.o : mofiles/configfmod.o
mtut.o : mofiles/commonmod.o
mtut.o : mofiles/configfmod.o
newdashboard.o : mofiles/commonmod.o
newdashboard.o : mofiles/configfmod.o
newdashboard.o : mofiles/dbmod.o
process.o : mofiles/commonmod.o
rmt.o : mofiles/apimod.o
rmt.o : mofiles/commonmod.o
rmt.o : mofiles/configfmod.o
rmt.o : mofiles/dbmod.o
rmt.o : mofiles/rmtmod.o
rmt.o : mofiles/servermod.o
runconfig.o : mofiles/commonmod.o
runs.o : mofiles/commonmod.o
runs.o : mofiles/configfmod.o
runs.o : mofiles/dbmod.o
runs.o : mofiles/servermod.o
server.o : mofiles/commonmod.o
server.o : mofiles/configfmod.o
server.o : mofiles/dbmod.o
server.o : mofiles/servermod.o
subrun.o : mofiles/commonmod.o
subrun.o : mofiles/configfmod.o
subrun.o : mofiles/dbmod.o
synchash.o : mofiles/dbmod.o
tasks.o : mofiles/commonmod.o
tasks.o : mofiles/configfmod.o
tasks.o : mofiles/dbmod.o
tcmt.o : mofiles/commonmod.o
tdb.o : mofiles/commonmod.o
tdb.o : mofiles/dbmod.o
tdb.o : mofiles/ods.o

tests.o : mofiles/commonmod.o
tests.o : mofiles/configfmod.o
tests.o : mofiles/dbmod.o
tests.o : mofiles/servermod.o
tree.o : mofiles/commonmod.o
tree.o : mofiles/dbmod.o

Modified common.scm from [e104413238] to [8132d96410].

︙︙
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412

      (debug:print-info 0 *default-log-port* "testpatt defined in "testpatt-key" from runconfigs: " rtestpatt)
      rtestpatt)
     (else 
      (debug:print-info 0 *default-log-port* "using testpatt " args-testpatt " rtestpatt:" rtestpatt)
      args-testpatt))))

;;======================================================================
(define (common:get-linktree)
  (or (getenv "MT_LINKTREE")
      (if *configdat*
	  (configf:lookup *configdat* "setup" "linktree")
	  #f)
      (if (or *toppath* (getenv "MT_RUN_AREA_HOME"))
	  (conc (or *toppath* (getenv "MT_RUN_AREA_HOME")) "/lt")
	  #f)
      (let* ((tp (common:get-toppath #f))
	     (lt (conc tp "/lt")))
	(if (not tp)(debug:print 0 *default-log-port* "WARNING: cannot calculate best path for linktree, using " lt))
	lt)))

(define (common:args-get-runname)
  (let ((res (or (args:get-arg "-runname")
		 (args:get-arg ":runname")
		 (getenv "MT_RUNNAME"))))
    ;; (if res (set-environment-variable "MT_RUNNAME" res)) ;; not sure if this is a good idea. side effect and all ...
    res))








<
<
<
<
<
<
<
<
<
<
<
<








387
388
389
390
391
392
393












394
395
396
397
398
399
400

      (debug:print-info 0 *default-log-port* "testpatt defined in "testpatt-key" from runconfigs: " rtestpatt)
      rtestpatt)
     (else 
      (debug:print-info 0 *default-log-port* "using testpatt " args-testpatt " rtestpatt:" rtestpatt)
      args-testpatt))))

;;======================================================================













(define (common:args-get-runname)
  (let ((res (or (args:get-arg "-runname")
		 (args:get-arg ":runname")
		 (getenv "MT_RUNNAME"))))
    ;; (if res (set-environment-variable "MT_RUNNAME" res)) ;; not sure if this is a good idea. side effect and all ...
    res))
︙︙

Modified commonmod.scm from [729100655f] to [77ecf25b1f].

︙︙
677
678
679
680
681
682
683

684
685
686
687
688
689
690

;; (define keys:config-get-fields common:get-fields)

(define (common:get-area-path-signature)
  (message-digest-string (md5-primitive) *toppath*))

(define (common:get-signature str)
  (message-digest-string (md5-primitive) str))


;;======================================================================
;; S Y S T E M   S T U F F
;;======================================================================

;;======================================================================
;; lazy-safe get file mod time. on any error (file not existing etc.) return 0








>








677
678
679
680
681
682
683
684
685
686
687
688
689
690
691

;; (define keys:config-get-fields common:get-fields)

(define (common:get-area-path-signature)
  (message-digest-string (md5-primitive) *toppath*))

(define (common:get-signature str)
  (message-digest-string (md5-primitive) str))


;;======================================================================
;; S Y S T E M   S T U F F
;;======================================================================

;;======================================================================
;; lazy-safe get file mod time. on any error (file not existing etc.) return 0
︙︙

Modified configfmod.scm from [16f9252379] to [9611c6d0e2].

︙︙
49
50
51
52
53
54
55













56
57
58
59
60
61
62

 )

(import commonmod)

;;======================================================================
;; move debug stuff to separate module then put these back where they belong
;;======================================================================














(define (common:get-testsuite-name)
  (or (configf:lookup *configdat* "setup" "area-name") ;; megatest is a flexible tool, testsuite is too limiting a description.
      (configf:lookup *configdat* "setup" "testsuite" )
      (getenv "MT_TESTSUITE_NAME")
      (pathname-file (or (if (string? *toppath* )
			     (pathname-file *toppath*)








>
>
>
>
>
>
>
>
>
>
>
>
>








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

 )

(import commonmod)

;;======================================================================
;; move debug stuff to separate module then put these back where they belong
;;======================================================================

(define (common:get-linktree)
  (or (getenv "MT_LINKTREE")
      (if *configdat*
	  (configf:lookup *configdat* "setup" "linktree")
	  #f)
      (if (or *toppath* (getenv "MT_RUN_AREA_HOME"))
	  (conc (or *toppath* (getenv "MT_RUN_AREA_HOME")) "/lt")
	  #f)
      (let* ((tp (common:get-toppath #f))
	     (lt (conc tp "/lt")))
	(if (not tp)(debug:print 0 *default-log-port* "WARNING: cannot calculate best path for linktree, using " lt))
	lt)))

(define (common:get-testsuite-name)
  (or (configf:lookup *configdat* "setup" "area-name") ;; megatest is a flexible tool, testsuite is too limiting a description.
      (configf:lookup *configdat* "setup" "testsuite" )
      (getenv "MT_TESTSUITE_NAME")
      (pathname-file (or (if (string? *toppath* )
			     (pathname-file *toppath*)
︙︙

Modified dbmod.scm from [3f7ad852eb] to [7ec1796d64].

︙︙
130
131
132
133
134
135
136




































137
138
139
140
141
142
143

	 default
	 (begin
	   (debug:print-error 0 *default-log-port* " query " stmt " failed, params: " params ", error: " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn)
	   (print-call-chain (current-error-port))
	   default)))
   (apply sqlite3:first-result db stmt params)))





































;; Open the classic megatest.db file (defaults to open in toppath)
;;
;;   NOTE: returns a dbdat not a dbstruct!
;;
(define (db:open-megatest-db #!key (path #f)(name #f))
  (let* ((dbdir        (or path *toppath*))
         (dbpath       (conc  dbdir "/" (or name "megatest.db")))








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
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

	 default
	 (begin
	   (debug:print-error 0 *default-log-port* " query " stmt " failed, params: " params ", error: " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn)
	   (print-call-chain (current-error-port))
	   default)))
   (apply sqlite3:first-result db stmt params)))

;; wait up to aprox n seconds for a journal to go away
;;
(define (tasks:wait-on-journal path n #!key (remove #f)(waiting-msg #f))
  (if (not (string? path))
      (debug:print-error 0 *default-log-port* "Called tasks:wait-on-journal with path=" path " (not a string)")
      (let ((fullpath (conc path "-journal")))
	(handle-exceptions
	 exn
	 (begin
	   (print-call-chain (current-error-port))
	   (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
	   (debug:print 5 *default-log-port* " exn=" (condition->list exn))
	   (debug:print 0 *default-log-port* "tasks:wait-on-journal failed. Continuing on, you can ignore this call-chain")
	   #t) ;; if stuff goes wrong just allow it to move on
	 (let loop ((journal-exists (common:file-exists? fullpath))
		    (count          n)) ;; wait ten times ...
	   (if journal-exists
	       (begin
		 (if (and waiting-msg
			  (eq? (modulo n 30) 0))
		     (debug:print 0 *default-log-port* waiting-msg))
		 (if (> count 0)
		     (begin
		       (thread-sleep! 1)
		       (loop (common:file-exists? fullpath)
			     (- count 1)))
		     (begin
		       (debug:print 0 *default-log-port* "ERROR: removing the journal file " fullpath ", this is not good. Look for disk full, write access and other issues.")
		       (if remove (system (conc "rm -rf " fullpath)))
		       #f)))
	       #t))))))

;;======================================================================
;; Megatest databases
;;======================================================================

;; Open the classic megatest.db file (defaults to open in toppath)
;;
;;   NOTE: returns a dbdat not a dbstruct!
;;
(define (db:open-megatest-db #!key (path #f)(name #f))
  (let* ((dbdir        (or path *toppath*))
         (dbpath       (conc  dbdir "/" (or name "megatest.db")))
︙︙

Modified http-transport.scm from [a9beb0fce8] to [6ba53c889c].

︙︙
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
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
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
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
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200

;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

(require-extension (srfi 18) extras tcp s11n)







(use  srfi-1 posix regex regex-case srfi-69 hostinfo md5 message-digest posix-extras)











(use spiffy uri-common intarweb http-client spiffy-request-vars intarweb spiffy-directory-listing)

;; Configurations for server
(tcp-buffer-size 2048)
(max-connections 2048) 

(declare (unit http-transport))

(declare (uses common))
(declare (uses db))
(declare (uses tasks)) ;; tasks are where stuff is maintained about what is running.
;; (declare (uses server))
;; (declare (uses daemon))
(declare (uses portlogger))


(declare (uses rmt))

(declare (uses commonmod))
(import commonmod)

(declare (uses configfmod))
(import configfmod)

(declare (uses dbmod))
(import dbmod)

(declare (uses servermod))
(import servermod)




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

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

;;======================================================================
;; S E R V E R
;; ======================================================================

;; Call this to start the actual server
;;

(define *db:process-queue-mutex* (make-mutex))

(define (http-transport:run hostn)
  ;; Configurations for server
  (tcp-buffer-size 2048)
  (max-connections 2048) 
  (debug:print 2 *default-log-port* "Attempting to start the server ...")
  (let* ((db              #f) ;;        (open-db)) ;; we don't want the server to be opening and closing the db unnecesarily
	 (hostname        (get-host-name))
	 (ipaddrstr       (let ((ipstr (if (string=? "-" hostn)
					   ;; (string-intersperse (map number->string (u8vector->list (hostname->ip hostname))) ".")
					   (server:get-best-guess-address hostname)
					   #f)))
			    (if ipstr ipstr hostn))) ;; hostname))) 
	 (start-port      (portlogger:open-run-close portlogger:find-port))
	 (link-tree-path  (common:get-linktree))
	 (tmp-area        (common:get-db-tmp-area))
	 (start-file      (conc tmp-area "/.server-start")))
    (debug:print-info 0 *default-log-port* "portlogger recommended port: " start-port)
    ;; set some parameters for the server
    (root-path     (if link-tree-path 
		       link-tree-path
		       (current-directory))) ;; WARNING: SECURITY HOLE. FIX ASAP!
    (handle-directory spiffy-directory-listing)
    (handle-exception (lambda (exn chain)
			(signal (make-composite-condition
				 (make-property-condition 
				  'server
				  'message "server error")))))

    ;; http-transport:handle-directory) ;; simple-directory-handler)
    ;; Setup the web server and a /ctrl interface
    ;;
    (vhost-map `(((* any) . ,(lambda (continue)
			       ;; open the db on the first call 
				 ;; This is were we set up the database connections
			       (let* (($   (request-vars source: 'both))
				      (dat ($ 'dat))
				      (res #f))
				 (cond
				  ((equal? (uri-path (request-uri (current-request)))
					   '(/ "api"))
				   (send-response body:    (api:process-request *dbstruct-db* $) ;; the $ is the request vars proc
						  headers: '((content-type text/plain)))
				   (mutex-lock! *heartbeat-mutex*)
				   (set! *db-last-access* (current-seconds))
				   (mutex-unlock! *heartbeat-mutex*))
				  ((equal? (uri-path (request-uri (current-request))) 
					   '(/ ""))
				   (send-response body: (http-transport:main-page)))
				  ((equal? (uri-path (request-uri (current-request))) 
					   '(/ "json_api"))
				   (send-response body: (http-transport:main-page)))
				  ((equal? (uri-path (request-uri (current-request))) 
					   '(/ "runs"))
				   (send-response body: (http-transport:main-page)))
				  ((equal? (uri-path (request-uri (current-request))) 
					   '(/ any))
				   (send-response body: "hey there!\n"
						  headers: '((content-type text/plain))))
				  ((equal? (uri-path (request-uri (current-request))) 
					   '(/ "hey"))
				   (send-response body: "hey there!\n" 
						  headers: '((content-type text/plain))))
                                  ((equal? (uri-path (request-uri (current-request))) 
					   '(/ "jquery3.1.0.js"))
				   (send-response body: (http-transport:show-jquery) 
						  headers: '((content-type application/javascript))))
                                  ((equal? (uri-path (request-uri (current-request))) 
					   '(/ "test_log"))
				   (send-response body: (http-transport:html-test-log $) 
						  headers: '((content-type text/HTML))))    
                                  ((equal? (uri-path (request-uri (current-request))) 
					   '(/ "dashboard"))
				   (send-response body: (http-transport:html-dboard $) 
						  headers: '((content-type text/HTML)))) 
				  (else (continue))))))))
    (handle-exceptions
	exn
      (debug:print 0 *default-log-port* "Failed to create file " start-file ", exn=" exn)
      (with-output-to-file start-file (lambda ()(print (current-process-id)))))
    (http-transport:try-start-server ipaddrstr start-port)))

;; This is recursively run by http-transport:run until sucessful
;;
(define (http-transport:try-start-server ipaddrstr portnum)
  (let ((config-hostname (configf:lookup *configdat* "server" "hostname"))
	(config-use-proxy (equal? (configf:lookup *configdat* "client" "use-http_proxy") "yes")))
    (if (not config-use-proxy)
	(determine-proxy (constantly #f)))
    (debug:print-info 0 *default-log-port* "http-transport:try-start-server time=" (seconds->time-string (current-seconds)) " ipaddrsstr=" ipaddrstr " portnum=" portnum " config-hostname=" config-hostname)
    (handle-exceptions
	exn
	(begin
	  (print-error-message exn)
	  (if (< portnum 64000)
	      (begin 
		(debug:print 0 *default-log-port* "WARNING: attempt to start server failed. Trying again ...")
		(debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
		(debug:print 5 *default-log-port* "exn=" (condition->list exn))
		(portlogger:open-run-close portlogger:set-failed portnum)
		(debug:print 0 *default-log-port* "WARNING: failed to start on portnum: " portnum ", trying next port")
		(thread-sleep! 0.1)
		
		;; get_next_port goes here
		(http-transport:try-start-server ipaddrstr
						 (portlogger:open-run-close portlogger:find-port)))
	      (begin
		(print "ERROR: Tried and tried but could not start the server"))))
      ;; any error in following steps will result in a retry
      (set! *server-info* (list ipaddrstr portnum))
      (debug:print 0 *default-log-port* "INFO: Trying to start server on " ipaddrstr ":" portnum)
      ;; This starts the spiffy server
      ;; NEED WAY TO SET IP TO #f TO BIND ALL
      ;; (start-server bind-address: ipaddrstr port: portnum)
      (if config-hostname ;; this is a hint to bind directly
	  (start-server port: portnum bind-address: (if (equal? config-hostname "-")
							ipaddrstr
							config-hostname))
	  (start-server port: portnum))
      (portlogger:open-run-close portlogger:set-port portnum "released")
      (debug:print 1 *default-log-port* "INFO: server has been stopped"))))

;;======================================================================
;; S E R V E R   U T I L I T I E S 
;;======================================================================

;;======================================================================
;; C L I E N T S
;;======================================================================








>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
|
<









|



>
>













>
>
>







<
<
<
<
<
|





<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<








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

;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

(require-extension (srfi 18) extras tcp s11n)


(use
 hostinfo
 http-client
 intarweb
 md5
 message-digest
 posix
 posix-extras
 regex
 regex-case
 spiffy
 spiffy-directory-listing
 spiffy-request-vars
 srfi-1
 srfi-69
 uri-common
 )


;; Configurations for server
(tcp-buffer-size 2048)
(max-connections 2048) 

(declare (unit http-transport))

(declare (uses common))
(declare (uses db))
;; (declare (uses tasks)) ;; tasks are where stuff is maintained about what is running.
;; (declare (uses server))
;; (declare (uses daemon))
(declare (uses portlogger))
(import portlogger)

(declare (uses rmt))

(declare (uses commonmod))
(import commonmod)

(declare (uses configfmod))
(import configfmod)

(declare (uses dbmod))
(import dbmod)

(declare (uses servermod))
(import servermod)

(declare (uses transport))
(import transport)

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

;; (require-library stml)






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

;;======================================================================
;; S E R V E R
;; ======================================================================































































































































;;======================================================================
;; S E R V E R   U T I L I T I E S 
;;======================================================================

;;======================================================================
;; C L I E N T S
;;======================================================================
︙︙

Modified portlogger.scm from [20f479e9c6] to [c7e5f6a357].

︙︙
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

;;     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/>.
;;

(require-extension (srfi 18) extras tcp s11n)

(use sqlite3 srfi-1 posix srfi-69 hostinfo dot-locking z3)
(import (prefix sqlite3 sqlite3:))

(declare (unit portlogger))
(declare (uses db))

(declare (uses commonmod))

(import commonmod)


(declare (uses configfmod))

(import configfmod)


(declare (uses dbmod))


(import dbmod)

;; lsof -i

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








<

<
<


|
|
|
>
|
>
|
|
>
|

>
|
>
>








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

;;     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))
;; (declare (uses db))
(declare (uses commonmod))
(declare (uses configfmod))
(declare (uses dbmod))

(module portlogger
	*

(import scheme chicken data-structures extras ports)
(import (srfi 18) extras tcp s11n)

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

(import commonmod)
(import configfmod)
(import dbmod)

;; lsof -i

(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))
︙︙
191
192
193
194
195
196
197



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










>
>

194
195
196
197
198
199
200
201
202

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

)

Modified server.scm from [37237a3d19] to [4b855f3685].

︙︙
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59


(declare (uses servermod))
(import servermod)

(include "common_records.scm")
(include "db_records.scm")

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

;;======================================================================
;; P K T S   S T U F F 
;;======================================================================

;; ???









|








45
46
47
48
49
50
51
52
53
54
55
56
57
58
59


(declare (uses servermod))
(import servermod)

(include "common_records.scm")
(include "db_records.scm")

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

;;======================================================================
;; P K T S   S T U F F 
;;======================================================================

;; ???
︙︙

Modified tasks.scm from [2d959c8f92] to [47c2b52e29].

︙︙
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

(include "task_records.scm")
(include "db_records.scm")

;;======================================================================
;; Tasks db
;;======================================================================

;; wait up to aprox n seconds for a journal to go away
;;
(define (tasks:wait-on-journal path n #!key (remove #f)(waiting-msg #f))
  (if (not (string? path))
      (debug:print-error 0 *default-log-port* "Called tasks:wait-on-journal with path=" path " (not a string)")
      (let ((fullpath (conc path "-journal")))
	(handle-exceptions
	 exn
	 (begin
	   (print-call-chain (current-error-port))
	   (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
	   (debug:print 5 *default-log-port* " exn=" (condition->list exn))
	   (debug:print 0 *default-log-port* "tasks:wait-on-journal failed. Continuing on, you can ignore this call-chain")
	   #t) ;; if stuff goes wrong just allow it to move on
	 (let loop ((journal-exists (common:file-exists? fullpath))
		    (count          n)) ;; wait ten times ...
	   (if journal-exists
	       (begin
		 (if (and waiting-msg
			  (eq? (modulo n 30) 0))
		     (debug:print 0 *default-log-port* waiting-msg))
		 (if (> count 0)
		     (begin
		       (thread-sleep! 1)
		       (loop (common:file-exists? fullpath)
			     (- count 1)))
		     (begin
		       (debug:print 0 *default-log-port* "ERROR: removing the journal file " fullpath ", this is not good. Look for disk full, write access and other issues.")
		       (if remove (system (conc "rm -rf " fullpath)))
		       #f)))
	       #t))))))

(define (tasks:get-task-db-path)
  (let ((dbdir  (or (configf:lookup *configdat* "setup" "monitordir")
		    (configf:lookup *configdat* "setup" "dbdir")
		    (conc (common:get-linktree) "/.db"))))
    (handle-exceptions
     exn
     (begin








<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<








41
42
43
44
45
46
47
































48
49
50
51
52
53
54

(include "task_records.scm")
(include "db_records.scm")

;;======================================================================
;; Tasks db
;;======================================================================

































(define (tasks:get-task-db-path)
  (let ((dbdir  (or (configf:lookup *configdat* "setup" "monitordir")
		    (configf:lookup *configdat* "setup" "dbdir")
		    (conc (common:get-linktree) "/.db"))))
    (handle-exceptions
     exn
     (begin
︙︙

Added transport.scm version [8a03c7ec77]. 







































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

1
2
3
4
5
6
7
8
9
10
11
12
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
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
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
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
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210

;;======================================================================
;; Copyright 2017, Matthew Welland.
;; 
;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     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 transport))
(declare (uses commonmod))
(declare (uses configfmod))
(declare (uses portlogger))

(module transport
	*
	
(import scheme chicken data-structures extras ports)

(import commonmod)
(import configfmod)

(import portlogger)

(import
  (prefix base64 base64:)
  (prefix sqlite3 sqlite3:)
  call-with-environment-variables
  csv
  csv-xml
  directory-utils
  files
  hostinfo
  http-client
  intarweb
  matchable
  md5
  message-digest
  posix
  posix-extras
  regex
  regex-case
  s11n
  spiffy
  spiffy-directory-listing
  spiffy-request-vars
  srfi-1
  srfi-13
  srfi-18
  srfi-69
  stack
  tcp
  typed-records
  uri-common
  z3
  )

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

;;======================================================================
;; S E R V E R
;; ======================================================================

;; Call this to start the actual server
;;

;; (define *db:process-queue-mutex* (make-mutex))

(define (http-transport:run hostn)
  ;; Configurations for server
  (tcp-buffer-size 2048)
  (max-connections 2048) 
  (debug:print 2 *default-log-port* "Attempting to start the server ...")
  (let* ((db              #f) ;;        (open-db)) ;; we don't want the server to be opening and closing the db unnecesarily
	 (hostname        (get-host-name))
	 (ipaddrstr       (let ((ipstr (if (string=? "-" hostn)
					   ;; (string-intersperse (map number->string (u8vector->list (hostname->ip hostname))) ".")
					   (server:get-best-guess-address hostname)
					   #f)))
			    (if ipstr ipstr hostn))) ;; hostname))) 
	 (start-port      (portlogger:open-run-close
			   (lambda (db)
			     (portlogger:find-port db))))
	 (link-tree-path  (common:get-linktree))
	 (tmp-area        (common:get-db-tmp-area))
	 (start-file      (conc tmp-area "/.server-start")))
    (debug:print-info 0 *default-log-port* "portlogger recommended port: " start-port)
    ;; set some parameters for the server
    (root-path     (if link-tree-path 
		       link-tree-path
		       (current-directory))) ;; WARNING: SECURITY HOLE. FIX ASAP!
    (handle-directory spiffy-directory-listing)
    (handle-exception (lambda (exn chain)
			(signal (make-composite-condition
				 (make-property-condition 
				  'server
				  'message "server error")))))

    ;; http-transport:handle-directory) ;; simple-directory-handler)
    ;; Setup the web server and a /ctrl interface
    ;;
    (vhost-map `(((* any) . ,(lambda (continue)
			       ;; open the db on the first call 
				 ;; This is were we set up the database connections
			       (let* (($   (request-vars source: 'both))
				      (dat ($ 'dat))
				      (res #f))
				 (cond
				  ((equal? (uri-path (request-uri (current-request)))
					   '(/ "api"))
				   (send-response body:    (api:process-request *dbstruct-db* $) ;; the $ is the request vars proc
						  headers: '((content-type text/plain)))
				   (mutex-lock! *heartbeat-mutex*)
				   (set! *db-last-access* (current-seconds))
				   (mutex-unlock! *heartbeat-mutex*))
				  ;; ((equal? (uri-path (request-uri (current-request))) 
				  ;; 	   '(/ ""))
				  ;;  (send-response body: (http-transport:main-page)))
				;;((equal? (uri-path (request-uri (current-request))) 
				;;	   '(/ "json_api"))
				;; (send-response body: (http-transport:main-page)))
				;;((equal? (uri-path (request-uri (current-request))) 
				;;	   '(/ "runs"))
				;; (send-response body: (http-transport:main-page)))
				;;((equal? (uri-path (request-uri (current-request))) 
				;;	   '(/ any))
				;; (send-response body: "hey there!\n"
				;;		  headers: '((content-type text/plain))))
				;;((equal? (uri-path (request-uri (current-request))) 
				;;	   '(/ "hey"))
				;; (send-response body: "hey there!\n" 
				;;		  headers: '((content-type text/plain))))
                                ;;((equal? (uri-path (request-uri (current-request))) 
				;;	   '(/ "jquery3.1.0.js"))
				;; (send-response body: (http-transport:show-jquery) 
				;;		  headers: '((content-type application/javascript))))
                                ;;((equal? (uri-path (request-uri (current-request))) 
				;;	   '(/ "test_log"))
				;; (send-response body: (http-transport:html-test-log $) 
				;;		  headers: '((content-type text/HTML))))    
                                ;;((equal? (uri-path (request-uri (current-request))) 
				;;	   '(/ "dashboard"))
				;; (send-response body: (http-transport:html-dboard $) 
				;;		  headers: '((content-type text/HTML)))) 
				  (else (continue))))))))
    (handle-exceptions
	exn
      (debug:print 0 *default-log-port* "Failed to create file " start-file ", exn=" exn)
      (with-output-to-file start-file (lambda ()(print (current-process-id)))))
    (http-transport:try-start-server ipaddrstr start-port)))


;; This is recursively run by http-transport:run until sucessful
;;
(define (http-transport:try-start-server ipaddrstr portnum)
  (let ((config-hostname (configf:lookup *configdat* "server" "hostname"))
	(config-use-proxy (equal? (configf:lookup *configdat* "client" "use-http_proxy") "yes")))
    (if (not config-use-proxy)
	(determine-proxy (constantly #f)))
    (debug:print-info 0 *default-log-port* "http-transport:try-start-server time=" (seconds->time-string (current-seconds)) " ipaddrsstr=" ipaddrstr " portnum=" portnum " config-hostname=" config-hostname)
    (handle-exceptions
	exn
	(begin
	  (print-error-message exn)
	  (if (< portnum 64000)
	      (begin 
		(debug:print 0 *default-log-port* "WARNING: attempt to start server failed. Trying again ...")
		(debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
		(debug:print 5 *default-log-port* "exn=" (condition->list exn))
		(portlogger:open-run-close portlogger:set-failed portnum)
		(debug:print 0 *default-log-port* "WARNING: failed to start on portnum: " portnum ", trying next port")
		(thread-sleep! 0.1)
		
		;; get_next_port goes here
		(http-transport:try-start-server ipaddrstr
						 (portlogger:open-run-close portlogger:find-port)))
	      (begin
		(print "ERROR: Tried and tried but could not start the server"))))
      ;; any error in following steps will result in a retry
      (set! *server-info* (list ipaddrstr portnum))
      (debug:print 0 *default-log-port* "INFO: Trying to start server on " ipaddrstr ":" portnum)
      ;; This starts the spiffy server
      ;; NEED WAY TO SET IP TO #f TO BIND ALL
      ;; (start-server bind-address: ipaddrstr port: portnum)
      (if config-hostname ;; this is a hint to bind directly
	  (start-server port: portnum bind-address: (if (equal? config-hostname "-")
							ipaddrstr
							config-hostname))
	  (start-server port: portnum))
      (portlogger:open-run-close
       (lambda (db)
	 (portlogger:set-port db portnum "released")))
      (debug:print 1 *default-log-port* "INFO: server has been stopped"))))


)

Modified utils/gendeps.scm from [cf8bd0f8fc] to [2d3420d303].

︙︙
22
23
24
25
26
27
28



29
30
31
32
33
34
35
36
37
38
39
40
41

 )

(define (portprint p . args)
  (with-output-to-port p
    (lambda ()
      (apply print args))))




(define (mofiles-adjust->dot-o inf)
  (regex-case
   inf
   ("^.*mod$" _ (conc "mofiles/"inf".o"))
   ("ods"     _ (conc "mofiles/"inf".o"))
   ("pgdb"    _ (conc "cgisetup/models/"inf".o"))
   (else (conc inf".o"))))

(define (hh-push ht k1 val)
  (hash-table-set! ht k1 (cons val (hash-table-ref/default ht k1 '()))))

(define (compunit targfname files)
  (let* ((unitdata   (make-hash-table))








>
>
>



|
|
|








22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44

 )

(define (portprint p . args)
  (with-output-to-port p
    (lambda ()
      (apply print args))))

(define modules-without-mod
  "(ods|transport|portlogger)")

(define (mofiles-adjust->dot-o inf)
  (regex-case
   inf
   ("^.*mod$"           _ (conc "mofiles/"inf".o"))
   (modules-without-mod _ (conc "mofiles/"inf".o"))
   ("pgdb"              _ (conc "cgisetup/models/"inf".o"))
   (else (conc inf".o"))))

(define (hh-push ht k1 val)
  (hash-table-set! ht k1 (cons val (hash-table-ref/default ht k1 '()))))

(define (compunit targfname files)
  (let* ((unitdata   (make-hash-table))
︙︙

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