Megatest

Diff
Login

Differences From Artifact [a18d19941b]:

To Artifact [fef840c2a5]:


235
236
237
238
239
240
241







242
243
244
245
246
247
248
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255







+
+
+
+
+
+
+







    (rerun-clean . "-rerun-clean")
    (rerun-all   . "-rerun-all")
    (sync        . "")
    (archive     . "-archive")
    (set-ss      . "-set-state-status")
    (remove      . "-remove-runs")))

;; manually keep this list updated from the keys to
;; the case *action* near the end of this file.
(define *other-actions*
  '(run remove rerun set-ss archive kill list
	dispatch import rungen process
	show gendot db tsend tlisten))

;; Card types:
;;
;; A action
;; U username (Unix)
;; D timestamp
;; T card type

1183
1184
1185
1186
1187
1188
1189
1190

1191
1192
1193
1194
1195
1196
1197
1190
1191
1192
1193
1194
1195
1196

1197
1198
1199
1200
1201
1202
1203
1204







-
+








(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.mtutilrc")))
  (if (common:file-exists? debugcontrolf)
      (load debugcontrolf)))

(if *action*
    (case (string->symbol *action*)
      ((run remove rerun set-ss archive kill list)
      ((run remove rerun rerun-clean rerun-all set-ss archive kill list)
       (let* ((mtconfdat (simple-setup (args:get-arg "-start-dir")))
	      (mtconf    (car mtconfdat))
	      (area      (args:get-arg "-area")) ;; look up the area to dispatch to from [areas] section
	      (areasec   (if area (configf:lookup mtconf "areas" area) #f))
	      (areadat   (if areasec (common:val->alist areasec) #f))
	      (area-path (if areadat (alist-ref 'path areadat) #f))
	      (pktsdirs  (configf:lookup mtconf "setup" "pktsdirs"))
1326
1327
1328
1329
1330
1331
1332
1333




1334
1335
1336
1337
1338
1339
1340
1333
1334
1335
1336
1337
1338
1339

1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350







-
+
+
+
+







														(set-signal-handler! signal/term special-signal-handler)

                            (let loop ((instr (nn-recv rep)))
                               (print "received " instr ", running \"" script " " instr "\"")
                               (system (conc script " '" instr "'"))
                               (nn-send rep "ok")
                               (loop (nn-recv rep))))
                     (print "ERROR: Port " portnum " already in use. Try another port")))))))
		       (print "ERROR: Port " portnum " already in use. Try another port")))))))
      (else
       (let ((all-actions (sort (map conc (delete-duplicates (append *other-actions* (map car *action-keys*)))) string<=?)))
	 (print "unrecognised action: \"" *action* "\", try one of; \"" (string-intersperse all-actions "\", \"") "\"")))
      
      )) ;; the end
             

;; If HTTP_HOST is defined then we must be in the cgi environment
;; so run stml and exit
;;