Megatest

       (setenv key val))
      (debug:print 0 "ERROR: bad value for setenv, key=" key ", value=" val)))

(define home (getenv "HOME"))
(define user (getenv "USER"))

;; GLOBAL GLETCHES
(define *db-keys* #f)
(define *configinfo* #f)
(define *configdat*  #f)
(define *toppath*    #f)
(define-record megatest:area
  name
  path
  transport
  configinfo
  configdat
  denoise
  client-signature
  remote
  )

(define *already-seen-runconfig-info* #f)
(define *waiting-queue*     (make-hash-table))
(define *test-meta-updated* (make-hash-table))
(define *globalexitstatus*  0) ;; attempt to work around possible thread issues
(define *passnum*           0) ;; when running track calls to run-tests or similar
(define *write-frequency*   (make-hash-table)) ;; run-id => (vector (current-seconds) 0))
(define *alt-log-file* #f)  ;; used by -log

(define *db-write-access*     #t)
(define *inmemdb*             #f)
(define *task-db*             #f) ;; (vector db path-to-db)
(define *db-access-allowed*   #t) ;; flag to allow access
(define *db-access-mutex*     (make-mutex))

;; SERVER
(define *my-client-signature* #f)
;; (define *my-client-signature* #f)
(define *transport-type*    'http)
(define *transport-type*    'http)             ;; override with [server] transport http|rpc|nmsg
(define *runremote*         (make-hash-table)) ;; if set up for server communication this will hold <host port>
;; (define *transport-type*    'http)             ;; override with [server] transport http|rpc|nmsg
;; (define *runremote*         (make-hash-table)) ;; if set up for server communication this will hold <host port>

(define (common:get-remote remote run-id)
  (let ((ht (or remote *runremote*)))
    (if ht
	(hash-table-ref/default ht run-id #f)
	#f)))

(define (common:set-remote! remote run-id value)
  (let ((ht (or remote *runremote*)))
    (if ht
	(hash-table-set! ht run-id value))))

(define (common:del-remote! remote run-id)
  (let ((ht (or remote *runremote*)))
    (if ht
	(hash-table-delete! ht run-id))))

(define (common:get-remote-all remote)
  (let ((ht (or remote *runremote*)))
    (if ht
	(hash-table-keys ht)
	'())))

(define *max-cache-size*    0)
(define *logged-in-clients* (make-hash-table))
(define *client-non-blocking-mode* #f)
(define *server-id*         #f)
(define *server-info*       #f)
(define *time-to-exit*      #f)
(define *received-response* #f)

  (let ((val (args:get-arg val)))
    (if val val default)))

(define (assoc/default key lst . default)
  (let ((res (assoc key lst)))
    (if res (cadr res)(if (null? default) #f (car default)))))

(define (common:get-testsuite-name)
  (or (configf:lookup *configdat* "setup" "testsuite" )
       (pathname-file *toppath*)))
(define (common:get-testsuite-name area-dat)
  (or (configf:lookup (megatest:area-configdat area-dat) "setup" "testsuite" )
       (pathname-file (megatest:area-path      area-dat))))

;;======================================================================
;; E X I T   H A N D L I N G
;;======================================================================

(define (std-exit-procedure)
(define (std-exit-procedure area-dat)
  (debug:print-info 2 "starting exit process, finalizing databases.")
  (rmt:print-db-stats)
  (let ((run-ids (hash-table-keys *db-local-sync*)))
  (rmt:print-db-stats area-dat)
  (let* ((configdat (megatest:area-configdat area-dat))
	 (run-ids (hash-table-keys *db-local-sync*)))
    (if (and (not (null? run-ids))
	     (configf:lookup *configdat* "setup" "megatest-db"))
	     (configf:lookup configdat "setup" "megatest-db"))
	(db:multi-db-sync run-ids 'new2old)))
  (if *dbstruct-db* (db:close-all *dbstruct-db*))
  (if *inmemdb*     (db:close-all *inmemdb*))
  (if (and *megatest-db*
	   (sqlite3:database? *megatest-db*))
      (begin
	(sqlite3:interrupt! *megatest-db*)