Megatest

  (if pktsdir
      (with-output-to-file
	  (conc pktsdir "/" uuid ".pkt")
	(lambda ()
	  (print pkt)))
      (print "ERROR: cannot process commands without a pkts directory")))

(define (check-if-modepatt-defined  pkta notification-hook pktfile)
  (let* ((start-dir (alist-ref 'S pkta))
	 (target (or (alist-ref 'R pkta) (alist-ref 't pkta)))
	 (patt (alist-ref 'o pkta))
	 (uuid    (alist-ref 'Z pkta))
	 (cmd (conc "megatest -show-runconfig -target " target " -start-dir " start-dir))
	 (res    (handle-exceptions
		  exn
		  #f
		  (print "Running " cmd)
		  (with-input-from-pipe cmd read-lines)))) 
    (let loop ((hed (car res))
	       (tail (cdr res)))
      (if (string-contains hed patt)
	  #t
	  (if (null? tail)
	      (begin
		(if notification-hook
		    (let* ((notification-cmd (conc notification-hook " --pkt " pktfile " --msg INVALID_MODEPATT")))
		      (print "Running " notification-cmd)
		      (system notification-cmd))) 
		#f)
	      (loop (car tail) (cdr tail)))))))

(define (check-if-target-defined pkta notification-hook pktfile)
  (let* ((start-dir (alist-ref 'S pkta))
	 (target (alist-ref 'R pkta))
	 (uuid    (alist-ref 'Z pkta))
	 (cmd (conc "megatest -list-targets -start-dir " start-dir))
	 (res    (handle-exceptions
		  exn
		  #f
		  (print "Running " cmd)
		  (with-input-from-pipe cmd read-lines)))) 
    (if (member target res)  
	#t 
	(begin 
	  (if notification-hook
	      (let* ((notification-cmd (conc notification-hook " --pkt "  pktfile " --msg INVALID_TARGET")))
		(print "Running " notification-cmd)
		(system notification-cmd)))
	  #f))))


(define (validate-cmd cmd pkta notification-hook pktfile)
  (let ((ret #t)) 
    (if (string-contains cmd "-reqtarg") 
	(if (check-if-target-defined pkta notification-hook pktfile)
	    (begin
	      (print "Target is valid")
	      (if (string-contains cmd "-modepatt")
		  (if (check-if-modepatt-defined pkta notification-hook pktfile)
		      (print "Modepatt is valid")
		      (set! ret #f))))
	    (set! ret #f))
	(if (string-contains cmd "-modepatt")
	    (if (check-if-modepatt-defined pkta notification-hook pktfile)
		(print "Modepatt is valid")
		(set! ret #f)))) 
    ret))

   
;; collect all needed data and create run pkts for contours with changed inputs
;;
(define (dispatch-commands mtconf toppath)
  ;; we are expecting a directory "logs", check and create it, create the log in /tmp if not able to create logs dir
  (let ((logdir
	 (if (if (not (directory? "logs"))
		 (handle-exceptions
		  exn
		  #f
		  (create-directory "logs")
		  #t)
		 #t)
	     "logs"
	     "/tmp"))
	(cpuload (alist-ref 'adj-proc-load (common:get-normalized-cpu-load #f)))
	(maxload (string->number (or (configf:lookup mtconf "setup" "maxload")
				     (configf:lookup mtconf "jobtools" "maxload") ;; respect value used by Megatest calls
				     "1.1")))
	(notification-hook (if (configf:lookup mtconf "setup" "notification-hook")
			       (configf:lookup mtconf "setup" "notification-hook")
			       #f)))
    (common:with-queue-db
     mtconf
     (lambda (pktsdirs pktsdir pdb)
       (let* ((rgconfdat (find-and-read-config (conc toppath "/runconfigs.config")))
	      (rgconf    (car rgconfdat))
	      (areas     (configf:get-section mtconf "areas"))
	      (contours  (configf:get-section mtconf "contours"))
	      (pkts      (find-pkts pdb '(cmd) '()))
	      (torun     (make-hash-table)) ;; target => ( ... info ... )
	      (rgentargs (hash-table-keys rgconf))) ;; these are the targets registered for automatically triggering
	 (for-each
	  (lambda (pktdat)
	    (let* ((pkta    (alist-ref 'apkt pktdat))
		   (action  (alist-ref 'A pkta))
		   (cmdline (pkt->cmdline pkta))
		   (uuid    (alist-ref 'Z pkta))
		   (user    (alist-ref 'U pkta))
		   (area    (alist-ref 'G pkta))
		   (logf    (conc logdir "/" uuid "-run.log"))
		   (pktfile (conc pktsdir "/" uuid ".pkt"))
		   (fullcmd (conc "NBFAKE_LOG=" logf " nbfake " cmdline)))
	      (if (check-access user mtconf action area)
		  (if (and (> cpuload maxload)
			   (member action '("run" "archive"))) ;; do not run archive or run if load is over the specified limit
		      (begin
			(print "WARNING: cpuload too high, skipping processing of " uuid " due to " cpuload " > " maxload)
			(if notification-hook
			    (let* ((notification-cmd (conc notification-hook " --pkt " pktfile " --msg HIGH_LOAD")))
			      (print "Running " notification-cmd) 
			      (system notification-cmd))))
		      (begin
			;; if modepatt used chek if it is defined for the target. If -reqtarg check if target exist.
			(if (validate-cmd fullcmd pkta notification-hook pktfile)
			    (begin
			      (print "RUNNING: " fullcmd)
			      (system fullcmd) ;; replace with process ...
			      (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
								  (else   action))
							     'G (alist-ref 'G pkta)
							     'c (alist-ref 'c pkta) ;; THIS IS WRONG! SHOULD BE 'c
							     't (alist-ref 't pkta)))))
				(write-pkt pktsdir ack-uuid ack-pkt))
			      (if notification-hook
				  (let* ((notification-cmd (conc notification-hook " --pkt " pktfile " --msg RUN_LAUNCHED --contour " (caar  contours) " --log_path " logf )))
				    (print "Running " notification-cmd)				
				    (system notification-cmd))))
			    (begin
			      (mark-processed pdb (list (alist-ref 'id pktdat)))
			      (let-values (((ack-uuid ack-pkt)
					    (add-z-card
					     (construct-sdat 'P uuid
							     'T "invalid-input"
							     'c (alist-ref 'o pkta) ;; THIS IS WRONG! SHOULD BE 'c
							     't (alist-ref 't pkta)))))
				(write-pkt pktsdir ack-uuid ack-pkt))))))
		  (begin ;; access denied! Mark as such
		    (mark-processed pdb (list (alist-ref 'id pktdat)))
		    (let-values (((ack-uuid ack-pkt)
				  (add-z-card
				   (construct-sdat 'P uuid
						   'T "access-denied"
						   'c (alist-ref 'o pkta) ;; THIS IS WRONG! SHOULD BE 'c
						   't (alist-ref 't pkta)))))
		      (write-pkt pktsdir ack-uuid ack-pkt))
		    (if notification-hook
			(let* ((notification-cmd (conc notification-hook " --pkt " pktfile " --msg ACCESS_DENIED")))
			  (print "Running " notification-cmd)
			  (system notification-cmd)))))))
	  pkts))))))


(define (check-access user mtconf action area)
  ;; NOTE: Need control over defaults. E.g. default might be no access
  (let* ((access-ctrl (hash-table-exists? mtconf "access"))  ;; if there is an access section the default is to REQUIRE enablement/access
	 (access-list (map (lambda (x)