Megatest

Changes On Branch v1.6512a
Login

Changes In Branch v1.6512a Excluding Merge-Ins

This is equivalent to a diff from fb7e6638f8 to 7a8dbd3299

2018-08-10
16:31
Merged mtutil changes into main 1.65 branch check-in: 058bef1510 user: jmoon18 tags: v1.65
11:52
Trimmed mtutil chattiness Leaf check-in: 7a8dbd3299 user: jmoon18 tags: v1.6512a
2018-08-01
10:58
Cherry-picked b04e check-in: 52591d24f4 user: mrwellan tags: v1.6512a
2018-07-10
13:47
Add a condition such that,the polling stops when it crosses 5000. check-in: 97716c5057 user: raghavki tags: v1.65
2018-07-02
11:44
Updated megatest version file check-in: fb7e6638f8 user: jmoon18 tags: v1.65, v1.6512
11:41
Updates to area-script trigger to filter packets by area check-in: d55ba5cbfd user: jmoon18 tags: v1.65

Modified common.scm from [2027cc1cac] to [eee99cc654].

57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
                                              (print-error-message exn) ))))
     (debug:print-info 0 *default-log-port* "    -- continuing after nonfatal condition...")
     #f)
   (thunk)))

(define getenv get-environment-variable)
(define (safe-setenv key val)
  (if (substring-index ":" key) ;; variables containing : are for internal use and cannot be environment variables.
      (debug:print-error 4 *default-log-port* "skip setting internal use only variables containing \":\"")
      (if (and (string? val)
	       (string? key))
	  (handle-exceptions
	      exn
	      (debug:print-error 0 *default-log-port* "bad value for setenv, key=" key ", value=" val)
	    (setenv key val))
	  (debug:print-error 0 *default-log-port* "bad value for setenv, key=" key ", value=" val))))







|
|







57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
                                              (print-error-message exn) ))))
     (debug:print-info 0 *default-log-port* "    -- continuing after nonfatal condition...")
     #f)
   (thunk)))

(define getenv get-environment-variable)
(define (safe-setenv key val)
  (if (or (substring-index "!" key) (substring-index ":" key)) ;; variables containing : are for internal use and cannot be environment variables.
      (debug:print-error 4 *default-log-port* "skip setting internal use only variables containing \":\" or starting with \"!\"")
      (if (and (string? val)
	       (string? key))
	  (handle-exceptions
	      exn
	      (debug:print-error 0 *default-log-port* "bad value for setenv, key=" key ", value=" val)
	    (setenv key val))
	  (debug:print-error 0 *default-log-port* "bad value for setenv, key=" key ", value=" val))))

Modified launch.scm from [46cdbaf4d6] to [7244e4f2ae].

652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
	     (lambda (section)
	       (for-each
		(lambda (varval)
		  (let ((var (car varval))
			(val (cadr varval)))
		    (if (and (string? var)(string? val))
			(begin
			  (setenv var (config:eval-string-in-environment val))) ;; val)
			(debug:print-error 0 *default-log-port* "bad variable spec, " var "=" val))))
		(configf:get-section rconfig section)))
	     (list "default" target)))
          ;;(bb-check-path msg: "launch:execute post block 1")

	  ;; NFS might not have propagated the directory meta data to the run host - give it time if needed
	  (let loop ((count 0))







|







652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
	     (lambda (section)
	       (for-each
		(lambda (varval)
		  (let ((var (car varval))
			(val (cadr varval)))
		    (if (and (string? var)(string? val))
			(begin
			  (safe-setenv var (config:eval-string-in-environment val))) ;; val)
			(debug:print-error 0 *default-log-port* "bad variable spec, " var "=" val))))
		(configf:get-section rconfig section)))
	     (list "default" target)))
          ;;(bb-check-path msg: "launch:execute post block 1")

	  ;; NFS might not have propagated the directory meta data to the run host - give it time if needed
	  (let loop ((count 0))

Modified mtut.scm from [9ba5c38876] to [2156541bf3].

786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
       (let* ((rgconfdat (find-and-read-config (conc toppath "/runconfigs.config")))
	      (rgconf    (car rgconfdat))
	      (all-areas (map car (configf:get-section mtconf "areas")))
	      (contours  (configf:get-section mtconf "contours"))
	      (torun     (make-hash-table)) ;; target => ( ... info ... )
	      (rgentargs (hash-table-keys rgconf))) ;; these are the targets registered for automatically triggering

	 (print "rgentargs: " rgentargs)
	 
	 (for-each
	  (lambda (runkey)
	    (let* ((keydats   (configf:get-section rgconf runkey)))
	      (for-each
	       (lambda (sense) ;; these are the sense rules
		 (let* ((key        (car sense))







|







786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
       (let* ((rgconfdat (find-and-read-config (conc toppath "/runconfigs.config")))
	      (rgconf    (car rgconfdat))
	      (all-areas (map car (configf:get-section mtconf "areas")))
	      (contours  (configf:get-section mtconf "contours"))
	      (torun     (make-hash-table)) ;; target => ( ... info ... )
	      (rgentargs (hash-table-keys rgconf))) ;; these are the targets registered for automatically triggering

	 ;;(print "rgentargs: " rgentargs)
	 
	 (for-each
	  (lambda (runkey)
	    (let* ((keydats   (configf:get-section rgconf runkey)))
	      (for-each
	       (lambda (sense) ;; these are the sense rules
		 (let* ((key        (car sense))
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
		     ;;
		     ((area-script)
		      ;; syntax is a little different here. It is a list of commands to run, "scriptname = extra_parameters;scriptname = ..."
		      ;; where scriptname may be repeated multiple times. The script must return unix-epoch of last change, new-target-name and new-run-name
		      ;; the script is called like this:  scriptname contour runkey std-runname action extra_param1 extra_param2 ...
		      (for-each
		       (lambda (cmd)
			 (print "cmd: " cmd)
                         (print "Areas: " all-areas)
                         (for-each 
                           (lambda (area) 
			     (if (area-allowed? area "area-needs-to-be-run" runkey contour #f) ;; is this area to be handled (from areas=a,b,c OR using areafn=abcfn and *area-checks* ...)
       
			     (let* ((script (car cmd))
				(params (cdr cmd))
				(cmd    (conc script " " contour " " area " " runkey " " std-runname " " action " " params))







|
|







946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
		     ;;
		     ((area-script)
		      ;; syntax is a little different here. It is a list of commands to run, "scriptname = extra_parameters;scriptname = ..."
		      ;; where scriptname may be repeated multiple times. The script must return unix-epoch of last change, new-target-name and new-run-name
		      ;; the script is called like this:  scriptname contour runkey std-runname action extra_param1 extra_param2 ...
		      (for-each
		       (lambda (cmd)
			 ;;(print "cmd: " cmd)
                         ;;(print "Areas: " all-areas)
                         (for-each 
                           (lambda (area) 
			     (if (area-allowed? area "area-needs-to-be-run" runkey contour #f) ;; is this area to be handled (from areas=a,b,c OR using areafn=abcfn and *area-checks* ...)
       
			     (let* ((script (car cmd))
				(params (cdr cmd))
				(cmd    (conc script " " contour " " area " " runkey " " std-runname " " action " " params))
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
							  ;;(target   . ,(list new-target)) ;; overriding with result from runing the script
                                                          ))
							(aval       (or (configf:lookup mtconf "areas" area) ""))
                                    			(aval-alist (common:val->alist aval))

							(targets (map-targets mtconf aval-alist runkey area contour)))
                                        (pp targets)
				        (for-each (lambda (target) (create-run-pkt mtconf action area runkey target runname mode-patt
                                                      tag-expr pktsdir reason contour sched dbdest append
                                                      runtrans)) targets)

                                       ;;(create-run-pkt mtconf action area runkey target runname
                                       ;;               pktsdir reason contour dbdest append
                                       ;;               runtrans)
				       (print "key-msg: " key-msg)







|







1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
							  ;;(target   . ,(list new-target)) ;; overriding with result from runing the script
                                                          ))
							(aval       (or (configf:lookup mtconf "areas" area) ""))
                                    			(aval-alist (common:val->alist aval))

							(targets (map-targets mtconf aval-alist runkey area contour)))
                                        (pp targets)
				        (for-each (lambda (target) (create-run-pkt mtconf action area runkey target new-runname mode-patt
                                                      tag-expr pktsdir reason contour sched dbdest append
                                                      runtrans)) targets)

                                       ;;(create-run-pkt mtconf action area runkey target runname
                                       ;;               pktsdir reason contour dbdest append
                                       ;;               runtrans)
				       (print "key-msg: " key-msg)
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
                                    (dbdest     (alist-ref 'dbdest  runkeydat))
                                    (append     (alist-ref 'append  runkeydat))
                                    (targets    ;;(or (alist-ref 'target  runkeydat)
                                                    (map-targets mtconf aval-alist runkey area contour))) ;; override with target if forced
                                    ;;(targets    (or (alist-ref 'target  runkeydat)
                                    ;;                (map-targets mtconf aval-alist runkey area contour)))) ;; override with target if forced
                               ;; NEED TO EXPAND RUNKEY => ALL TARGETS MAPPED AND THEN FOREACH .... 
                               (print "Targets: " targets)
                               (print "alist: " (alist-ref 'target runkeydat))
                               (for-each
                                (lambda (target)
                                  (print "Creating pkt for runkey=" runkey " target=" target " contour=" contour " area=" area " action=" action " tag-expr=" tag-expr " mode-patt=" mode-patt)
                                  (if (case (or (and action (string->symbol action)) 'noaction)  ;; ensure we have the needed data to run this action
                                        ((noaction)           #f)
                                        ((run)                (and runname reason))
                                        ((sync sync-prepend)  (and reason dbdest))







|
|







1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
                                    (dbdest     (alist-ref 'dbdest  runkeydat))
                                    (append     (alist-ref 'append  runkeydat))
                                    (targets    ;;(or (alist-ref 'target  runkeydat)
                                                    (map-targets mtconf aval-alist runkey area contour))) ;; override with target if forced
                                    ;;(targets    (or (alist-ref 'target  runkeydat)
                                    ;;                (map-targets mtconf aval-alist runkey area contour)))) ;; override with target if forced
                               ;; NEED TO EXPAND RUNKEY => ALL TARGETS MAPPED AND THEN FOREACH .... 
                               ;;(print "Targets: " targets)
                               ;;(print "alist: " (alist-ref 'target runkeydat))
                               (for-each
                                (lambda (target)
                                  (print "Creating pkt for runkey=" runkey " target=" target " contour=" contour " area=" area " action=" action " tag-expr=" tag-expr " mode-patt=" mode-patt)
                                  (if (case (or (and action (string->symbol action)) 'noaction)  ;; ensure we have the needed data to run this action
                                        ((noaction)           #f)
                                        ((run)                (and runname reason))
                                        ((sync sync-prepend)  (and reason dbdest))