1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
|
;; (if (args:get-arg "-target")
;; (if (string= (args:get-arg "-target") runkey) (area-allowed? area "area-needs-to-be-run" runkey contour #f) #f)
;; (area-allowed? area "area-needs-to-be-run" runkey contour #f))))
;;(print "Area Allowed: " (area-allowed? area "area-needs-to-be-run" runkey contour #f))
;Add code to check whether area is valid
(if
;; This code checks whether the target has been passed in via argument, and only runs the specified target
(and (< packets-generated (or (string->number (if (configf:lookup mtconf "setup" "max_packets_per_run") (configf:lookup mtconf "setup" "max_packets_per_run") "10000" )) 10000)) (if (args:get-arg "-target")
(if (string= (args:get-arg "-target") runkey) (area-allowed? area "area-needs-to-be-run" runkey contour #f) #f)
(area-allowed? area "area-needs-to-be-run" runkey contour #f)))
(let* ((script (car cmd))
(params (cdr cmd))
(cmd (conc script " " contour " " area " " runkey " " std-runname " " action " " params))
(res (handle-exceptions
exn
#f
|
|
>
|
|
|
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
|
;; (if (args:get-arg "-target")
;; (if (string= (args:get-arg "-target") runkey) (area-allowed? area "area-needs-to-be-run" runkey contour #f) #f)
;; (area-allowed? area "area-needs-to-be-run" runkey contour #f))))
;;(print "Area Allowed: " (area-allowed? area "area-needs-to-be-run" runkey contour #f))
;Add code to check whether area is valid
(if
;; This code checks whether the target has been passed in via argument, and only runs the specified target
(and (< packets-generated (or (string->number (if (configf:lookup mtconf "setup" "max_packets_per_run") (configf:lookup mtconf "setup" "max_packets_per_run") "10000" )) 10000))
(if (args:get-arg "-target")
(if (string= (args:get-arg "-target") runkey) (area-allowed? area "area-needs-to-be-run" runkey contour #f) #f)
(area-allowed? area "area-needs-to-be-run" runkey contour #f)))
(let* ((script (car cmd))
(params (cdr cmd))
(cmd (conc script " " contour " " area " " runkey " " std-runname " " action " " params))
(res (handle-exceptions
exn
#f
|
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
|
;; (for-each
;; (lambda (key)
;; (if (not (member key *legal-params*))
;; (hash-table-delete! adjargs key))) ;; we need to delete any params intended for mtutil
;; (hash-table-keys adjargs))
(let-values (((uuid pkt)
(command-line->pkt *action* adjargs #f area-path: area-path new-ss: new-ss)))
(write-pkt pktsdir uuid pkt))))
((dispatch import rungen process)
(let* ((mtconfdat (simple-setup (args:get-arg "-start-dir")))
(mtconf (car mtconfdat))
(toppath (configf:lookup mtconf "scratchdat" "toppath")))
(case (string->symbol *action*)
((process) (begin
|
>
|
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
|
;; (for-each
;; (lambda (key)
;; (if (not (member key *legal-params*))
;; (hash-table-delete! adjargs key))) ;; we need to delete any params intended for mtutil
;; (hash-table-keys adjargs))
(let-values (((uuid pkt)
(command-line->pkt *action* adjargs #f area-path: area-path new-ss: new-ss)))
(print "run log @ " (conc (current-directory) "/" uuid "-" *action* ".log"))
(write-pkt pktsdir uuid pkt))))
((dispatch import rungen process)
(let* ((mtconfdat (simple-setup (args:get-arg "-start-dir")))
(mtconf (car mtconfdat))
(toppath (configf:lookup mtconf "scratchdat" "toppath")))
(case (string->symbol *action*)
((process) (begin
|