235
236
237
238
239
240
241
242
243
244
245
246
247
248
|
(rerun-clean . "-rerun-clean")
(rerun-all . "-rerun-all")
(sync . "")
(archive . "-archive")
(set-ss . "-set-state-status")
(remove . "-remove-runs")))
;; Card types:
;;
;; A action
;; U username (Unix)
;; D timestamp
;; T card type
|
>
>
>
>
>
>
>
|
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
|
(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)
(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"))
|
|
|
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 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
|
(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")))))))
)) ;; the end
;; If HTTP_HOST is defined then we must be in the cgi environment
;; so run stml and exit
;;
|
|
>
>
>
|
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")))))))
(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
;;
|