Megatest

    ("-status"          . s)
    ("-target"          . t)
    ("-tag-expr"        . x)
    ;; misc
    ("-debug"           . #f)  ;; for *verbosity* > 2
    ("-load"            . #f)  ;; load and exectute a scheme file
    ("-log"             . #f)
    ("-override-user"   . #f)
    ("-msg"             . M)
    ("-start-dir"       . S)
    ("-set-vars"        . v)
    ("-config"          . h)
    ))
(define *switch-keys*
  '(

;;
;; sched => force the run start time to be recorded as sched Unix
;; epoch. This aligns times properly for triggers in some cases.
;;
;;  extra-dat format is ( 'x xval 'y yval .... )
;;
(define (command-line->pkt action args-alist sched-in #!key (extra-dat '())(area-path #f)(new-ss #f))
  (let* ((sched     (cond
   (let* ((sched     (cond
		     ((vector? sched-in)(local-time->seconds sched-in)) ;; we recieved a time
		     ((number? sched-in) sched-in)
		     (else     (current-seconds))))
   (user  (if (and args-alist (hash-table? args-alist))
              (hash-table-ref/default args-alist "-override-user" (current-user-name))
						  (current-user-name)))
                    
	 (args-data (if args-alist
			(if (hash-table? args-alist) ;; seriously?
			    (hash-table->alist args-alist)
			    args-alist)
			(hash-table->alist args:arg-hash))) ;; if no args-alist then we assume this is a call driven directly by commandline
	 (alldat    (apply append
			   (list 'A action
				 'U (current-user-name)
				 'U user
				 'D sched)
			   (if area-path
			       (list 'S area-path) ;; the area-path is mapped to the start-dir
			       '())
                           (if (list? extra-dat)
			       extra-dat
			       (begin
				 (debug:print 0 *default-log-port* "ERROR: command-line->pkt received bad extra-dat " extra-dat)
				 '()))
			   (map (lambda (x)
				  (let* ((param (car x))
					 (value (cdr x))
					 (pmeta (assoc param *arg-keys*))    ;; translate the card key to a megatest switch or parameter
					 (smeta (assoc param *switch-keys*)) ;; first lookup the key in arg-keys or switch-keys
					 (meta  (if (or pmeta smeta)
						    (cdr (or pmeta smeta))   ;; found it?
						    #f)))
				    (if (or pmeta smeta)                     ;; construct the switch/param pair.
           (if meta                     ;; construct the switch/param pair.
					(list meta value)
					'())))
          
				(filter cdr args-data)))))
    (print  "Alldat: " alldat
    (print  "Alldat: " alldat  ) ;;Do not removed. This is uesed by other applications to calculate z card 
	    " args-data: " args-data)
    ;(exit)
    (add-z-card
     (apply construct-sdat alldat))))

(define (simple-setup start-dir-in)
  (let* ((start-dir (or start-dir-in "."))
	 (mtconfig  (or (args:get-arg "-config") "megatest.config"))
	 (mtconfdat (find-and-read-config        ;; NB// sets MT_RUN_AREA_HOME as side effect

				  (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))))))
	  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)
			     (string-split x ":"))
			   (string-split (or (configf:lookup mtconf "access" area) ;; userid:rightstype userid2:rightstype2 ...
					     (if access-ctrl
						 "*:none"  ;; nobody has access by default
						 "*:all")))))
	 (access-types-dat (configf:get-section mtconf "accesstypes")))
    (debug:print 0 *default-log-port* "Checking access in " access-list " with access-ctrl " access-ctrl " for area " area)
    (debug:print 2 *default-log-port* "Checking access in " access-list " with access-ctrl " access-ctrl " for area " area)
    (if access-ctrl
	(let* ((user-access     (or (assoc user access-list)
				    (assoc "*"  access-list)))
	       (access-type   (if user-access
	       (access-type     (cadr user-access))
												  (cadr user-access)
                           #f))
	       (access-types    (let ((res (alist-ref access-type access-types-dat equal?)))
				  (if res (car res) res)))
	       (allowed-actions (string-split (or access-types ""))))
	  (print "Got " allowed-actions " for user " user " where access-types=" access-types " access-type=" access-type)
	  (debug:print 2 *default-log-port* "Got " allowed-actions " for user " user " where access-types=" access-types " access-type=" access-type)
	  (cond
	   ((and access-types (member action allowed-actions))
	    ;; (print "Access granted for " user " for " action)
	    #t)
	   (else
	    ;; (print "Access denied for " user " for " action)
	    #f))))))

	  ((and area (not area-path))
	   (print "ERROR: the specified area was not found in the [areas] table. Area name=" area)
	   (exit 1))
	  ((not area)
	   (print "ERROR: no area specified. Use -area <areaname>")
	   (exit 1))
	  (else
	   (let* ((usr-admin (check-access (current-user-name) mtconf "override" area))
					(user (if (and usr-admin (args:get-arg "-override-user"))
                    (args:get-arg "-override-user")
	   (let ((user (current-user-name)))
	     (if (check-access user mtconf *action* area);; check rights
									  (current-user-name))))
       ; (print "user 123 " usr-admin )
        ;(exit 1)
     (if (and (not usr-admin) (args:get-arg "-override-user"))
         (begin
            (print  user " does not have access to override user")
          (exit 1)))
	   (if (check-access user mtconf *action* area);; check rights
		 (print "Access granted for " *action* " action by " user)
		 (begin
		   (print "Access denied for " *action* " action by " user)
		   (exit 1))))))
	 
	 ;; (for-each
	 ;;  (lambda (key)