Megatest

Check-in [47b1c10120]
Login
Overview
Comment:Fixed few bugs in trigger handling
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.64
Files: files | file ages | folders
SHA1: 47b1c10120842bd00d51149815c799f6929d016c
User & Date: matt on 2017-03-07 09:41:03
Other Links: branch diff | manifest | tags
Context
2017-03-08
10:43
Merged v1.63 into v1.64 check-in: 6d5ee7f187 user: matt tags: v1.64
2017-03-07
09:41
Fixed few bugs in trigger handling check-in: 47b1c10120 user: matt tags: v1.64
07:41
Partially correct sync time handling for cron check-in: 66afe01542 user: matt tags: v1.64
Changes

Modified common.scm from [9f89c1cf57] to [676cf9cc1d].

1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924





1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935

1936
1937
1938

1939
1940
1941
1942
1943
1944
1945
1913
1914
1915
1916
1917
1918
1919





1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934

1935
1936
1937

1938
1939
1940
1941
1942
1943
1944
1945







-
-
-
-
-
+
+
+
+
+










-
+


-
+







		(is-in  #f))
	    (for-each
	     (lambda (moment)
	       (if (and before
			(<= before now-seconds)
			(>= moment now-seconds))
		   (begin
		     (print)
		     (print "Before: " (time->string (seconds->local-time before)))
		     (print "Now:    " (time->string (seconds->local-time now-seconds)))
		     (print "After:  " (time->string (seconds->local-time moment)))
		     (print "Last:   " (time->string (seconds->local-time last-done)))
		     ;; (print)
		     ;; (print "Before: " (time->string (seconds->local-time before)))
		     ;; (print "Now:    " (time->string (seconds->local-time now-seconds)))
		     ;; (print "After:  " (time->string (seconds->local-time moment)))
		     ;; (print "Last:   " (time->string (seconds->local-time last-done)))
		     (if (<  last-done before)
			 (set! is-in before))
		     ))
	       (set! before moment))
	     (sort (hash-table-keys all-times) <))
	    is-in)))))

(define (common:extended-cron  cron-str now-seconds-in last-done)
  (let ((expanded-cron (common:cron-expand cron-str)))
    (if (string? expanded-cron)
	expanded-cron
	(common:cron-event expanded-cron now-seconds-in last-done)
	(let loop ((hed (car expanded-cron))
		   (tal (cdr expanded-cron)))
	  (if (cron-event hed now-seconds-in last-done)
	  (if (common:cron-event hed now-seconds-in last-done)
	      #t
	      (if (null? tal)
		  #f
		  (loop (car tal)(cdr tal))))))))

;;======================================================================
;; C O L O R S

Modified mtut.scm from [fc89c63934] to [ede27f1fb5].

355
356
357
358
359
360
361











362
363
364
365
366
367
368
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379







+
+
+
+
+
+
+
+
+
+
+







      (string-split pktsdirs)))))

(define (get-pkt-alists pkts)
  (map (lambda (x)
	 (alist-ref 'pkta x)) ;; 'pkta pulls out the alist from the read pkt
       pkts))

;; given list of pkts (alist mode) return list of D cards as Unix epoch, sorted descending
;; also delete duplicates by target i.e. (car pkt)
(define (get-pkt-times pkts)
  (delete-duplicates
   (sort 
    (map (lambda (x)
	   `(,(alist-ref 't x) . ,(string->number (alist-ref 'D x))))
	 pkts)
    (lambda (a b)(> (cdr a)(cdr b))))      ;; sort descending
   (lambda (a b)(equal? (car a)(car b))))) ;; remove duplicates by target

;;======================================================================
;; Runs
;;======================================================================

;; make a runname
;;
(define (make-runname pre post)
462
463
464
465
466
467
468
469
470
471
472
473





474
475
476
477
478
479
480
473
474
475
476
477
478
479





480
481
482
483
484
485
486
487
488
489
490
491







-
-
-
-
-
+
+
+
+
+







    (let-values (((uuid pkt)
		  (command-line->pkt
		   (if action action "run")
		   (append 
		    `(("-start-dir"  . ,area-path)
		      ("-msg"        . ,reason)
		      ("-contour"    . ,contour))
		    (if runname    '(("-run-name"   . ,runname))      '())
		    (if new-target `(("-target"     . ,new-target))   '())
		    (if mode-patt  `(("-mode-patt"  . ,mode-patt))    '())
		    (if tag-expr   `(("-tag-expr"   . ,tag-expr))     '())
		    (if dbdest	   `(("-sync-to"    . ,dbdest))       '())
		    (if runname     `(("-run-name"   . ,runname))      '())
		    (if new-target  `(("-target"     . ,new-target))   '())
		    (if mode-patt   `(("-mode-patt"  . ,mode-patt))    '())
		    (if tag-expr    `(("-tag-expr"   . ,tag-expr))     '())
		    (if dbdest	    `(("-sync-to"    . ,dbdest))       '())
		    (if append-conf `(("-append-config" . ,append-conf)) '())
		    (if (not (or mode-patt tag-expr))
			`(("-testpatt"  . "%"))
			'())
		    )
		   sched)))
      (with-output-to-file
515
516
517
518
519
520
521
522

523
524
525
526
527
528
529
530
531
532
533
534
535
536

537
538
539
540
541
542
543
544
545
546
547
548





549
550
551
552
553
554
555
556
557
526
527
528
529
530
531
532

533







534
535
536
537
538
539

540







541
542
543


544
545
546
547
548
549

550
551
552
553
554
555
556







-
+
-
-
-
-
-
-
-






-
+
-
-
-
-
-
-
-



-
-
+
+
+
+
+

-







			;; (val-list   (string-split-fields ";\\s*" val #:infix)) ;; (string-split val)) ;; runname-rule params
			(val-alist  (val->alist val))
			(runname    (make-runname "" ""))
			(runstarts  (find-pkts pdb '(runstart) `((o . ,contour)
								 (t . ,runkey))))
			(rspkts     (get-pkt-alists runstarts))
			;; starttimes is for run start times and is used to know when the last run was launched
			(starttimes ;; sort by age (youngest first) and delete duplicates by target
			(starttimes (get-pkt-times rspkts)) ;; sort by age (youngest first) and delete duplicates by target
			 (delete-duplicates
			  (sort 
			   (map (lambda (x)
				  `(,(alist-ref 't x) . ,(string->number (alist-ref 'D x))))
				rspkts)
			   (lambda (a b)(> (cdr a)(cdr b))))      ;; sort descending
			  (lambda (a b)(equal? (car a)(car b))))) ;; remove duplicates by target
			(last-run (if (null? starttimes) ;; if '() then it has never been run, else get the max
				      0
				      (apply max (map cdr starttimes))))
			;; synctimes is for figuring out the last time a sync was done
			(syncstarts   (find-pkts pdb '(syncstart) '())) ;; no qualifiers, a sync does all tarets etc.
			(sspkts       (get-pkt-alists syncstarts))
			(synctimes
			(synctimes    (get-pkt-times  sspkts))
			 (delete-duplicates
			  (sort 
			   (map (lambda (x)
				  `(,(alist-ref 't x) . ,(string->number (alist-ref 'D x))))
				sspkts)
			   (lambda (a b)(> (cdr a)(cdr b))))      ;; sort descending
			  (lambda (a b)(equal? (car a)(car b))))) ;; remove duplicates by target
			(last-sync (if (null? synctimes) ;; if '() then it has never been run, else get the max
				      0
				      (apply max (map cdr synctimes))))

			)
			)

		   (let ((delta (lambda (x)
				  (round (/ (- (current-seconds) x) 60)))))
		     (print "runkey: " runkey ", ruletype: " ruletype ", action: " action ", time since; last-run: " (delta last-run) ", last-sync: " (delta last-sync)))

		   (print "runkey: " runkey " ruletype: " ruletype " action: " action)
		   ;; look in runstarts for matching runs by target and contour
		   ;; get the timestamp for when that run started and pass it
		   ;; to the rule logic here where "ruletype" will be applied
		   ;; if it comes back "changed" then proceed to register the runs
		   
		   (case (string->symbol (or ruletype "no-such-rule"))

639
640
641
642
643
644
645
646


647
648
649
650


651
652
653
654
655
656
657
658
659
660
661
662

663
664
665
666
667
668
669
670
671
672

673
674
675
676
677
678
679
680
681
682
683
684
685
686

687
688
689
690
691
692
693
694
695
696
697
698
699
700
701

702
703
704
705
706
707
708
638
639
640
641
642
643
644

645
646
647
648
649

650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713







-
+
+



-
+
+












+










+














+















+







			   (if (not url-is-file) ;; need to sync first
			       (fossil:clone-or-sync url fname fdir))
			   (let-values (((datetime node)
					 (fossil:last-change-node-and-time fdir fname branch)))
			     (if (null? starttimes)
				 (push-run-spec torun contour runkey
						`((message . ,(conc "fossil:" branch "-neverrun"))
						  (runname . ,(conc runname "-" node))))
						  (runname . ,(conc runname "-" node))
						  (target  . ,runkey)))
				 (if (> datetime last-run) ;; change time is greater than last-run time
				     (push-run-spec torun contour runkey
						    `((message . ,(conc "fossil:" branch "-" node))
						      (runname . ,(conc runname "-" node))))))
						      (runname . ,(conc runname "-" node))
						      (target  . ,runkey)))))
			     (print "Got datetime=" datetime " node=" node))))
		       val-alist))
		     
		     ((file file-or) ;; one or more files must be newer than the reference
		      (let* ((file-globs  (alist-ref 'glob val-alist))
			     (youngestdat (common:get-youngest (common:bash-glob file-globs)))
			     (youngestmod (car youngestdat)))
			;; (print "youngestmod: " youngestmod " starttimes: " starttimes)
			(if (null? starttimes) ;; this target has never been run
			    (push-run-spec torun contour runkey
					   `((message . "file:neverrun")
					     (action  . ,action)
					     (target  . ,runkey)
					     (runname . ,runname)))
			;; (for-each
			;;  (lambda (starttime) ;; look at the time the last run was kicked off for this contour
			;;    (if (> youngestmod (cdr starttime))
			;; 	   (begin
			;; 	     (print "starttime younger than youngestmod: " starttime " Youngestmod: " youngestmod)
			    (if (> youngestmod last-run)
				(push-run-spec torun contour runkey
					       `((message . ,(conc ruletype ":" (cadr youngestdat)))
						 (action  . ,action)
						 (target  . ,runkey)
						 (runname . ,runname)
						 ))))))
		      ;; starttimes))

		     ((file-and) ;; all files must be newer than the reference
		      (let* ((file-globs  (alist-ref 'glob val-alist))
			     (youngestdat (common:get-youngest file-globs))
			     (youngestmod (car youngestdat))
			     (success     #t)) ;; any cases of not true, set flag to #f for AND
			;; (print "youngestmod: " youngestmod " starttimes: " starttimes)
			(if (null? starttimes) ;; this target has never been run
			    (push-run-spec torun contour runkey
					   `((message . "file:neverrun")
					     (runname . ,runname)
					     (target  . ,runkey)
					     (action  . ,action)))
			    ;; NB// I think this is wrong. It should be looking at last-run only.
			    (if (> youngestmod last-run)
				
				;; 			    (for-each
				;; 			     (lambda (starttime) ;; look at the time the last run was kicked off for this contour
				;; 			       (if (< youngestmod (cdr starttime))
				;; 				   (set! success #f)))
				;; 			     starttimes))
				;; 			(if success
				;; 			    (begin
				;; 			      (print "starttime younger than youngestmod: " starttime " Youngestmod: " youngestmod)
				(push-run-spec torun contour runkey
					       `((message . ,(conc ruletype ":" (cadr youngestdat)))
						 (runname . ,runname)
						 (target  . ,runkey)
						 (action  . ,action)
						 ))))))
		     (else (print "ERROR: unrecognised rule \"" ruletype)))))
	       keydats))) ;; sense rules
	  (hash-table-keys rgconf))
	 
	 ;; now have to run populated
728
729
730
731
732
733
734
735

736
737
738
739
740
741
742
733
734
735
736
737
738
739

740
741
742
743
744
745
746
747







-
+







			 (let ((runname (alist-ref 'runname runkeydat))
			       (reason  (alist-ref 'message runkeydat))
			       (sched   (alist-ref 'sched   runkeydat))
			       (action  (alist-ref 'action  runkeydat))
			       (dbdest  (alist-ref 'dbdest  runkeydat))
			       (append  (alist-ref 'append  runkeydat))
			       (target  (or (alist-ref 'target  runkeydat) runkey))) ;; override with target if forced
			   (print "Have: runkey=" runkey " contour=" contour " area=" area " action=" action " tag-expr=" tag-expr " mode-patt=" mode-patt)
			   (print "Have: runkey=" runkey " contour=" contour " area=" area " action=" action " tag-expr=" tag-expr " mode-patt=" mode-patt " target=" target)
			   (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)     (and reason dbdest))
				 (else       #f))
			       ;; instead of unwrapping the runkeydat alist, pass it directly to create-run-pkt
			       (create-run-pkt mtconf action area runkey runname mode-patt tag-expr pktsdir reason contour sched dbdest append) 
804
805
806
807
808
809
810
811
812




813
814
815
816
817
818
819
809
810
811
812
813
814
815


816
817
818
819
820
821
822
823
824
825
826







-
-
+
+
+
+







	      (rgentargs (hash-table-keys rgconf))) ;; these are the targets registered for automatically triggering
	 (for-each
	  (lambda (pktdat)
	    (let* ((pkta    (alist-ref 'pkta pktdat))
		   (action  (alist-ref 'a pkta))
		   (cmdline (pkt->cmdline pkta))
		   (uuid    (alist-ref 'Z pkta))
		   (logf    (conc logdir "/" uuid "-run.log")))
	      (system (conc "NBFAKE_LOG=" logf " nbfake " cmdline))
		   (logf    (conc logdir "/" uuid "-run.log"))
		   (fullcmd (conc "NBFAKE_LOG=" logf " nbfake " cmdline)))
	      (print "RUNNING: " fullcmd)
	      (system fullcmd)
	      (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

Modified runconfigs.config from [aa6963f9bf] to [90595474a2].

1
2
3
4
5

6
7
8
9
10
11
12
13

14
15
16
17
18
19
20
1
2
3
4

5
6
7
8
9
10
11
12

13
14
15
16
17
18
19
20




-
+







-
+








# example of a cron entry to run sync using db spec pgdb, with pgdb setting in file local.config
#
[a/b/c]
all:scheduled:sync     cron=  5 * * * *;dbdest=pgdb;appendconf=/mfs/matt/.sysmaint/local.config
# all:scheduled:sync     cron=  0/5 * * * *;dbdest=pgdb;appendconf=/mfs/matt/.sysmaint/local.config

# tip will be replaced with hashkey
[v1.63/tip/dev]
# file:   files changes since last run trigger new run
# script: script is called with unix seconds as last parameter (other parameters are preserved)
#
# contour:sensetype:action params            data
# quick:file:run             run-name=auto;glob=/home/matt/data/megatest/*.scm
quick:file:run             run-name=auto;glob=/home/matt/data/megatest/*.scm

# script returns change-time (unix epoch), new-target-name, run-name
#
# quick:script:run           checkfossil = http://www.kiatoa.com/fossils/megatest v1.63;\
#                            checkfossil = http://www.kiatoa.com/fossils/megatest_qa trunk

# fossil based trigger

tests/fullrun/tests/runfirst/main.sh became executable with contents [2f5036b48c].