116
117
118
119
120
121
122
123
124
125
126
127
128
129
|
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
|
+
+
+
+
|
archive : compress and move test data to archive disk
kill : stop tests or entire runs
db : database utilities
areas, contours, setup : show areas, contours or setup section from megatest.config
Contour actions:
process : runs import, rungen and dispatch
Trigger propagation actions:
tsend a=b,c=d... : send trigger info to all recpients in the [listeners] section
tlisten -port N : listen for trigger info on port N
Selectors
-immediate : apply this action immediately, default is to queue up actions
-area areapatt1,area2... : apply this action only to the specified areas
-target key1/key2/... : run for key1, key2, etc.
-test-patt p1/p2,p3/... : % is wildcard
-run-name : required, name for this particular test run
|
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
|
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
|
-
+
|
(fullcmd (conc "NBFAKE_LOG=" logf " nbfake " cmdline)))
(if (check-access user mtconf action area)
(if (and (> cpuload maxload)
(member action '("run" "archive"))) ;; do not run archive or run if load is over the specified limit
(print "WARNING: cpuload too high, skipping processing of " uuid)
(begin
(print "RUNNING: " fullcmd)
(system fullcmd)
(system fullcmd) ;; replace with process ...
(mark-processed pdb (list (alist-ref 'id pktdat)))
(let-values (((ack-uuid ack-pkt)
(add-z-card
(construct-sdat 'P uuid
'T (case (string->symbol action)
((run) "runstart")
((sync) "syncstart") ;; example of translating run -> runstart
|
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
|
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
|
-
+
+
+
+
+
+
|
(system (conc "/bin/cat " schema-file)))))
((sqlite3schema)
(let* ((install-home (common:get-install-area))
(schema-file (conc install-home "/share/db/mt-sqlite3.sql")))
(if (common:file-exists? schema-file)
(system (conc "/bin/cat " schema-file)))))
((junk)
(rmt:get-keys))))))))
(rmt:get-keys))))))
((tsend)
(if (null? remargs)
(print "ERROR: missing data to send to trigger listeners")
(let ((cmd (car remargs)))
(case (string->symbol subcmd)))))))
;; If HTTP_HOST is defined then we must be in the cgi environment
;; so run stml and exit
;;
(if (get-environment-variable "HTTP_HOST")
(begin
(stml:main #f)
|