Megatest

;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================

(declare (unit commonmod))
;; (declare (uses processmod))
(declare (uses stml2))
(declare (uses mtargs))

(module commonmod
	*
	
(import scheme chicken data-structures extras)
	
(import (prefix sqlite3 sqlite3:) posix typed-records srfi-18
	srfi-1 files format srfi-13 matchable 
	srfi-69 ports
	regex-case regex hostinfo srfi-4
	pkts (prefix dbi dbi:)
	stack
	md5
	message-digest



	z3 (prefix base64 base64:)
	(prefix mtargs args:))
(import stml2)

(include "common_records.scm")
(include "megatest-fossil-hash.scm")
(include "megatest-version.scm")

 ;; no need to export this
(define *verbosity-cache* (make-hash-table))
(define *verbosity* 0)














































































































;; this was cached based on results from profiling but it turned out the profiling
;; somehow went wrong - perhaps too many processes writing to it. Leaving the caching
;; in for now but can probably take it out later.
;;
(define (debug:calc-verbosity vstr verbose quiet) ;; verbose and quiet are #f or enabled
  (or (hash-table-ref/default *verbosity-cache* vstr #f)
      (let ((res (cond

	(lambda ()
	  ;; (if *logging*
	  ;;    (let ((res (format#format #f "INFO: (~a) ~a" n (apply conc params))))
		;; (exec-fn 'db:log-event res))
	      ;; (apply print "pid:" (current-process-id) " " "INFO: (" n ") " params) ;; res)
	  (apply print "INFO: (" n ") " params) ;; res)
	  )))) ;; )

































































































;;======================================================================
;; S T A T E S   A N D   S T A T U S E S
;;======================================================================

;; BBnote: *common:std-states* - dashboard filter control and test control state buttons defined here; used in set-fields-panel and dboard:make-controls

(define (get-file-descriptor-count #!key  (pid (current-process-id )))
  (list
    (length (glob (conc "/proc/" pid "/fd/*")))
    (length  (filter identity (map socket? (glob (conc "/proc/" pid "/fd/*")))))
  )
)

  

;; GLOBALS

;; CONTEXTS
#;(defstruct cxt
  (taskdb #f)
  (cmutex (make-mutex)))
;; (define *contexts* (make-hash-table))
;; (define *context-mutex* (make-mutex))

;; ;; safe method for accessing a context given a toppath
;; ;;
;; (define (common:with-cxt toppath proc)
;;   (mutex-lock! *context-mutex*)
;;   (let ((cxt (hash-table-ref/default *contexts* toppath #f)))
;;     (if (not cxt)
;;         (set! cxt (let ((x (make-cxt)))(hash-table-set! *contexts* toppath x) x)))
;;     (let ((cxt-mutex (cxt-mutex cxt)))
;;       (mutex-unlock! *context-mutex*)
;;       (mutex-lock! cxt-mutex)
;;       (let ((res (proc cxt)))
;;         (mutex-unlock! cxt-mutex)
;;         res))))
        
;; A hash table that can be accessed by #{scheme ...} calls in
;; config files. Allows communicating between confgs
;;
(define *user-hash-data* (make-hash-table))

(define *db-keys* #f)

(define *pkts-info*    (make-hash-table)) ;; store stuff like the last parent here
(define *configinfo*   #f)   ;; raw results from setup, includes toppath and table from megatest.config
(define *runconfigdat* #f)   ;; run configs data
(define *configdat*    #f)   ;; megatest.config data
(define *configstatus* #f)   ;; status of data; 'fulldata : all processing done, #f : no data yet, 'partialdata : partial read done
(define *toppath*      #f)
(define *already-seen-runconfig-info* #f)

(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 *alt-log-file* #f)  ;; used by -log
(define *common:denoise*    (make-hash-table)) ;; for low noise printing
(define *default-log-port*  (current-error-port))
(define *default-area-tag* "local")

;; DATABASE
(define *dbstruct-db*         #f) ;; used to cache the dbstruct in db:setup. Goal is to remove this.
;; db access
(define *db-last-access*      (current-seconds)) ;; last db access, used in server
(define *db-write-access*     #t)

;; db sync
(define *db-last-sync*        0)                 ;; last time the sync to megatest.db happened
(define *db-sync-in-progress* #f)                ;; if there is a sync in progress do not try to start another
(define *db-multi-sync-mutex* (make-mutex))      ;; protect access to *db-sync-in-progress*, *db-last-sync*
;; task db
(define *task-db*             #f) ;; (vector db path-to-db)
(define *db-access-allowed*   #t) ;; flag to allow access
(define *db-access-mutex*     (make-mutex))
(define *db-transaction-mutex* (make-mutex))
(define *db-cache-path*       #f)
(define *db-with-db-mutex*    (make-mutex))
(define *db-api-call-time*    (make-hash-table)) ;; hash of command => (list of times)
;; no sync db
(define *no-sync-db*          #f)

;; SERVER
(define *my-client-signature* #f)
(define *transport-type*    'http)             ;; override with [server] transport http|rpc|nmsg
(define *runremote*         #f)                ;; if set up for server communication this will hold <host port>
;; (define *max-cache-size*    0)
(define *logged-in-clients* (make-hash-table))
(define *server-id*         #f)
(define *server-info*       #f)  ;; good candidate for easily convert to non-global
(define *time-to-exit*      #f)
(define *server-run*        #t)
(define *run-id*            #f)
(define *server-kind-run*   (make-hash-table))
(define *home-host*         #f)
;; (define *total-non-write-delay* 0)
(define *heartbeat-mutex*   (make-mutex))
(define *api-process-request-count* 0)
(define *max-api-process-requests* 0)
(define *server-overloaded*  #f)

;; client
(define *rmt-mutex*         (make-mutex))     ;; remote access calls mutex 

;; RPC transport
(define *rpc:listener*      #f)

;; KEY info
(define *target*            (make-hash-table)) ;; cache the target here; target is keyval1/keyval2/.../keyvalN
(define *keys*              (make-hash-table)) ;; cache the keys here
(define *keyvals*           (make-hash-table))
(define *toptest-paths*     (make-hash-table)) ;; cache toptest path settings here
(define *test-paths*        (make-hash-table)) ;; cache test-id to test run paths here
(define *test-ids*          (make-hash-table)) ;; cache run-id, testname, and item-path => test-id
(define *test-info*         (make-hash-table)) ;; cache the test info records, update the state, status, run_duration etc. from testdat.db

(define *run-info-cache*     (make-hash-table)) ;; run info is stable, no need to reget
(define *launch-setup-mutex* (make-mutex))     ;; need to be able to call launch:setup often so mutex it and re-call the real deal only if *toppath* not set
(define *homehost-mutex*     (make-mutex))

;; Miscellaneous
(define *triggers-mutex*     (make-mutex))     ;; block overlapping processing of triggers

















;; (define (common:low-noise-print alldat waitval . keys)
;;   (let* ((key      (string-intersperse (map conc keys) "-" ))
;; 	 (lasttime (hash-table-ref/default (alldat-denoise alldat) key 0))
;; 	 (currtime (current-seconds)))
;;     (if (> (- currtime lasttime) waitval)
;; 	(begin
;; 	  (hash-table-set! (alldat-denoise alldat) key currtime)
;; 	  #t)
;; 	#f)))
;; 
;; (define (common:version-signature alldat)
;;   (conc (alldat-megatest-version alldat)
;; 	"-" (substring (alldat-megatest-fossil-hash alldat) 0 4)))
;; 
;; (define (common:get-fields cfgdat)
;;   (let ((fields (hash-table-ref/default cfgdat "fields" '())))
;;     (map car fields)))
;; 
;; ;;======================================================================
;; ;; T I M E   A N D   D A T E
;; ;;======================================================================
;; 
;; ;; Convert strings like "5s 2h 3m" => 60x60x2 + 3x60 + 5
;; (define (common:hms-string->seconds tstr)
;;   (let ((parts     (string-split-fields "\\w+" tstr))
;; 	(time-secs 0)
;; 	;; s=seconds, m=minutes, h=hours, d=days, M=months, y=years, w=weeks
;; 	(trx       (regexp "(\\d+)([smhdMyw])")))
;;     (for-each (lambda (part)
;; 		(let ((match  (string-match trx part)))
;; 		  (if match
;; 		      (let ((val (string->number (cadr match)))
;; 			    (unt (caddr match)))
;; 			(if val 
;; 			    (set! time-secs (+ time-secs (* val
;; 							    (case (string->symbol unt)
;; 							      ((s) 1)
;; 							      ((m) 60) ;; minutes
;; 							      ((h) 3600)
;; 							      ((d) 86400)
;; 							      ((w) 604800)
;; 							      ((M) 2628000) ;; aproximately one month
;; 							      ((y) 31536000)
;; 							      (else #f))))))))))

;; 	      parts)
;;     time-secs))
;; 		       
;; (define (seconds->hr-min-sec secs)
;;   (let* ((hrs (quotient secs 3600))
;; 	 (min (quotient (- secs (* hrs 3600)) 60))
;; 	 (sec (- secs (* hrs 3600)(* min 60))))
;;     (conc (if (> hrs 0)(conc hrs "hr ") "")
;; 	  (if (> min 0)(conc min "m ")  "")
;; 	  sec "s")))
;; 
;; (define (seconds->time-string sec)
;;   (time->string 
;;    (seconds->local-time sec) "%H:%M:%S"))
;; 
;; (define (seconds->work-week/day-time sec)
;;   (time->string
;;    (seconds->local-time sec) "ww%V.%u %H:%M"))
;; 
;; (define (seconds->work-week/day sec)
;;   (time->string
;;    (seconds->local-time sec) "ww%V.%u"))
;; 
;; (define (seconds->year-work-week/day sec)
;;   (time->string
;;    (seconds->local-time sec) "%yww%V.%w"))
;; 
;; (define (seconds->year-work-week/day-time sec)
;;   (time->string
;;    (seconds->local-time sec) "%Yww%V.%w %H:%M"))
;; 
;; (define (seconds->year-week/day-time sec)
;;   (time->string
;;    (seconds->local-time sec) "%Yw%V.%w %H:%M"))
;; 
;; (define (seconds->quarter sec)
;;   (case (string->number
;; 	 (time->string 
;; 	  (seconds->local-time sec)
;; 	  "%m"))

;;     ((1 2 3) 1)
;;     ((4 5 6) 2)
;;     ((7 8 9) 3)
;;     ((10 11 12) 4)
;;     (else #f)))
;; 
;; ;; basic ISO8601 format (e.g. "2017-02-28 06:02:54") date time => Unix epoch
;; ;;
;; (define (common:date-time->seconds datetime)

;;   (local-time->seconds (string->time datetime "%Y-%m-%d %H:%M:%S")))
;; 
;; ;; given span of seconds tstart to tend
;; ;; find start time to mark and mark delta
;; ;;
;; (define (common:find-start-mark-and-mark-delta tstart tend)
;;   (let* ((deltat   (- (max tend (+ tend 10)) tstart)) ;; can't handle runs of less than 4 seconds. Pad it to 10 seconds ...
;; 	 (result   #f)
;; 	 (min      60)
;; 	 (hr       (* 60 60))
;; 	 (day      (* 24 hr))
;; 	 (yr       (* 365 day)) ;; year
;; 	 (mo       (/ yr 12))
;; 	 (wk       (* day 7)))
;;     (for-each
;;      (lambda (max-blks)
;;        (for-each
;; 	(lambda (span) ;; 5 2 1
;; 	  (if (not result)
;; 	      (for-each 
;; 	       (lambda (timeunit timesym) ;; year month day hr min sec
;; 		 (if (not result)
;; 		     (let* ((time-blk (* span timeunit))
;; 			    (num-blks (quotient deltat time-blk)))
;; 		       (if (and (> num-blks 4)(< num-blks max-blks))
;; 			   (let ((first (* (quotient tstart time-blk) time-blk)))

;; 			     (set! result (list span timeunit time-blk first timesym))
;; 			     )))))
;; 	       (list yr mo wk day hr min 1)
;; 	       '(     y  mo w  d   h  m   s))))
;; 	(list 8 6 5 2 1)))
;;      '(5 10 15 20 30 40 50 500))
;;     (if values
;; 	(apply values result)
;; 	(values 0 day 1 0 'd))))
;; 
;; ;; given x y lim return the cron expansion
;; ;;
;; (define (common:expand-cron-slash x y lim)
;;   (let loop ((curr x)
;; 	     (res  `()))
;;     (if (< curr lim)

;; 	(loop (+ curr y) (cons curr res))
;; 	(reverse res))))
;; 
;; ;; expand a complex cron string to a list of cron strings

;; ;;
;; ;;  x/y   => x, x+y, x+2y, x+3y while x+Ny<max_for_field
;; ;;  a,b,c => a, b ,c
;; ;;
;; ;;   NOTE: with flatten a lot of the crud below can be factored down.
;; ;;
;; (define (common:cron-expand cron-str)
;;   (if (list? cron-str)
;;       (flatten
;;        (fold (lambda (x res)
;; 	       (if (list? x)
;; 		   (let ((newres (map common:cron-expand x)))
;; 		     (append x newres))
;; 		   (cons x res)))
;; 	     '()

;; 	     cron-str)) ;; (map common:cron-expand cron-str))
;;       (let ((cron-items (string-split cron-str))
;; 	    (slash-rx   (regexp "(\\d+)/(\\d+)"))
;; 	    (comma-rx   (regexp ".*,.*"))
;; 	    (max-vals   '((min        . 60)
;; 			  (hour       . 24)
;; 			  (dayofmonth . 28) ;;; BUG!!!! This will be a bug for some combinations
;; 			  (month      . 12)
;; 			  (dayofweek  . 7))))
;; 	(if (< (length cron-items) 5) ;; bad spec
;; 	    cron-str ;; `(,cron-str)              ;; just return the string, something downstream will fix it
;; 	    (let loop ((hed  (car cron-items))
;; 		       (tal  (cdr cron-items))
;; 		       (type 'min)
;; 		       (type-tal '(hour dayofmonth month dayofweek))
;; 		       (res  '()))
;; 	      (regex-case
;; 		  hed
;; 		(slash-rx ( _ base incr ) (let* ((basen          (string->number base))
;; 						 (incrn          (string->number incr))
;; 						 (expanded-vals  (common:expand-cron-slash basen incrn (alist-ref type max-vals)))
;; 						 (new-list-crons (fold (lambda (x myres)
;; 									 (cons (conc (if (null? res)
;; 											 ""
;; 											 (conc (string-intersperse res " ") " "))
;; 										     x " " (string-intersperse tal " "))
;; 									       myres))
;; 								       '() expanded-vals)))
;; 					    ;; (print "new-list-crons: " new-list-crons)
;; 					    ;; (fold (lambda (x res)
;; 					    ;; 	    (if (list? x)

;; 					    ;; 		(let ((newres (map common:cron-expand x)))
;; 					    ;; 		  (append x newres))

;; 					    ;; 		(cons x res)))
;; 					    ;; 	  '()


;; 					    (flatten (map common:cron-expand new-list-crons))))
;; 		;;					    (map common:cron-expand (map common:cron-expand new-list-crons))))
;; 		(else (if (null? tal)
;; 			  cron-str
;; 			  (loop (car tal)(cdr tal)(car type-tal)(cdr type-tal)(append res (list hed)))))))))))
;; 		      
;; 	    
;; ;; given a cron string and the last time event was processed return #t to run or #f to not run
;; ;;


;; ;;  min    hour   dayofmonth month  dayofweek
;; ;; 0-59    0-23   1-31       1-12   0-6          ### NOTE: dayofweek does not include 7
;; ;;
;; ;;  #t => yes, run the job
;; ;;  #f => no, do not run the job
;; ;;
;; (define (common:cron-event cron-str now-seconds-in last-done) ;; ref-seconds = #f is NOW.
;;   (let* ((cron-items     (map string->number (string-split cron-str)))
;; 	 (now-seconds    (or now-seconds-in (current-seconds)))
;; 	 (now-time       (seconds->local-time now-seconds))
;; 	 (last-done-time (seconds->local-time last-done))
;; 	 (all-times      (make-hash-table)))
;;     ;; (print "cron-items: " cron-items "(length cron-items): " (length cron-items))
;;     (if (not (eq? (length cron-items) 5)) ;; don't even try to figure out junk strings
;; 	#f
;; 	(match-let (((     cmin chour cdayofmonth cmonth    cdayofweek)
;; 		     cron-items)
;; 		    ;; 0     1    2        3         4    5      6
;; 		    ((nsec nmin nhour ndayofmonth nmonth nyr ndayofweek n7 n8 n9)
;; 		     (vector->list now-time))
;; 		    ((lsec lmin lhour ldayofmonth lmonth lyr ldayofweek l7 l8 l9)
;; 		     (vector->list last-done-time)))
;; 	  ;; create all possible time slots
;; 	  ;; remove invalid slots due to (for example) day of week
;; 	  ;; get the start and end entries for the ref-seconds (current) time
;; 	  ;; if last-done > ref-seconds => this is an ERROR!
;; 	  ;; does the last-done time fall in the legit region?
;; 	  ;;    yes => #f  do not run again this command
;; 	  ;;    no  => #t  ok to run the command
;; 	  (for-each ;; month
;; 	   (lambda (month)
;; 	     (for-each ;; dayofmonth
;; 	      (lambda (dom)
;; 		(for-each
;; 		 (lambda (hr) ;; hour
;; 		   (for-each
;; 		    (lambda (minute) ;; minute
;; 		      (let ((copy-now (apply vector (vector->list now-time))))

;; 			(vector-set! copy-now 0 0) ;; force seconds to zero
;; 			(vector-set! copy-now 1 minute)
;; 			(vector-set! copy-now 2 hr)
;; 			(vector-set! copy-now 3 dom)  ;; dom is already corrected for zero referenced
;; 			(vector-set! copy-now 4 month)
;; 			(let* ((copy-now-secs (local-time->seconds copy-now))
;; 			       (new-copy      (seconds->local-time copy-now-secs))) ;; remake the time vector
;; 			  (if (or (not cdayofweek)
;; 				  (equal? (vector-ref new-copy 6)
;; 					  cdayofweek)) ;; if the day is specified and a match OR if the day is NOT specified
;; 			      (if (or (not cdayofmonth)
;; 				      (equal? (vector-ref new-copy 3)
;; 					      (+ 1 cdayofmonth))) ;; if the month is specified and a match OR if the month is NOT specified

;; 				  (hash-table-set! all-times copy-now-secs new-copy))))))
;; 		    (if cmin
;; 			`(,cmin)  ;; if given cmin, have to use it

;; 			(list (- nmin 1) nmin (+ nmin 1))))) ;; minute
;; 		 (if chour
;; 		     `(,chour)
;; 		     (list (- nhour 1) nhour (+ nhour 1))))) ;; hour
;; 	      (if cdayofmonth
;; 		  `(,cdayofmonth)
;; 		  (list (- ndayofmonth 1) ndayofmonth (+ ndayofmonth 1)))))

;; 	   (if cmonth
;; 	       `(,cmonth)
;; 	       (list (- nmonth 1) nmonth (+ nmonth 1))))
;; 	  (let ((before #f)
;; 		(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)))
;; 		     (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)
;; 	(common:cron-event expanded-cron now-seconds-in last-done)
;; 	(let loop ((hed (car expanded-cron))
;; 		   (tal (cdr expanded-cron)))
;; 	  (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
;; ;;======================================================================
;;       
;; (define (common:name->iup-color name)
;;   (case (string->symbol (string-downcase name))
;;     ((red)    "223 33 49")
;;     ((grey)   "192 192 192")
;;     ((orange) "255 172 13")
;;     ((purple) "This is unfinished ...")))
;; 
;; ;; (define (common:get-color-for-state-status state status)
;; ;;   (case (string->symbol state)
;; ;;     ((COMPLETED)
;; ;;      (case (string->symbol status)
;; ;;        ((PASS)        "70  249 73")
;; ;;        ((WARN WAIVED) "255 172 13")
;; ;;        ((SKIP)        "230 230 0")
;; ;;        (else "223 33 49")))
;; ;;     ((LAUNCHED)         "101 123 142")
;; ;;     ((CHECK)            "255 100 50")
;; ;;     ((REMOTEHOSTSTART)  "50  130 195")
;; ;;     ((RUNNING)          "9   131 232")
;; ;;     ((KILLREQ)          "39  82  206")
;; ;;     ((KILLED)           "234 101 17")
;; ;;     ((NOT_STARTED)      "240 240 240")
;; ;;     (else               "192 192 192")))
;; 
;; (define (common:iup-color->rgb-hex instr)
;;   (string-intersperse 
;;    (map (lambda (x)
;;           (number->string x 16))
;;         (map string->number
;;              (string-split instr)))
;;    "/"))
;; 
;; ;; dot-locking egg seems not to work, using this for now
;; ;; if lock is older than expire-time then remove it and try again
;; ;; to get the lock

;; ;;
;; (define (common:simple-file-lock fname #!key (expire-time 300))
;;     (if (file-exists? fname)
;; 	(if (> (- (current-seconds)(file-modification-time fname)) expire-time)
;; 	    (begin
;;               (handle-exceptions exn #f (delete-file* fname))	
;; 	      (common:simple-file-lock fname expire-time: expire-time))
;; 	    #f)
;; 	(let ((key-string (conc (get-host-name) "-" (current-process-id))))
;; 	  (with-output-to-file fname
;; 	    (lambda ()
;; 	      (print key-string)))
;; 	  (thread-sleep! 0.25)
;; 	  (if (file-exists? fname)
;; 	      (handle-exceptions exn
;;                 #f 
;;                 (with-input-from-file fname
;; 	  	  (lambda ()
;; 		    (equal? key-string (read-line)))))
;; 	      #f))))
;; 
;; (define (common:simple-file-lock-and-wait fname #!key (expire-time 300))
;;   (let ((end-time (+ expire-time (current-seconds))))
;;     (let loop ((got-lock (common:simple-file-lock fname expire-time: expire-time)))
;;       (if got-lock
;; 	  #t
;; 	  (if (> end-time (current-seconds))
;; 	      (begin
;; 		(thread-sleep! 3)
;; 		(loop (common:simple-file-lock fname expire-time: expire-time)))
;; 	      #f)))))
;; 
;; (define (common:simple-file-release-lock fname)
;;   (handle-exceptions
;;       exn
;;       #f ;; I don't really care why this failed (at least for now)
;;     (delete-file* fname)))
;; 
;; ;; lazy-safe get file mod time. on any error (file not existing etc.) return 0
;; ;;
;; (define (common:lazy-modification-time fpath)
;;   (handle-exceptions
;;       exn
;;       0
;;       (file-modification-time fpath)))
;; 
;; ;; find timestamp of newest file associated with a sqlite db file
;; (define (common:lazy-sqlite-db-modification-time fpath)
;;   (let* ((glob-list (handle-exceptions
;; 			exn
;; 			`(,(conc "/no/such/file, message: " ((condition-property-accessor 'exn 'message) exn)))
;; 		      (glob (conc fpath "*"))))
;;          (file-list (if (eq? 0 (length glob-list))
;; 			'("/no/such/file")
;; 			glob-list)))
;;   (apply max
;;    (map
;;     common:lazy-modification-time 
;;     file-list))))
;; 
;; 
;; ;; execute thunk, return value.  If exception thrown, trap exception, return #f, and emit nonfatal condition note to *default-log-port* .
;; ;; arguments - thunk, message
;; (define (common:fail-safe thunk warning-message-on-exception)
;;   (handle-exceptions
;;    exn
;;    (begin
;;      (debug:print-info 0 *default-log-port* "notable but nonfatal condition - "warning-message-on-exception)
;;      (debug:print-info 0 *default-log-port*

;;                        (string-substitute "\n?Error:" "nonfatal condition:"
;;                                           (with-output-to-string
;;                                             (lambda ()
;;                                               (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))))
;; 
;; (define home (getenv "HOME"))
;; (define user (getenv "USER"))
;; 
;; 
;; ;; returns list of fd count, socket count
;; (define (get-file-descriptor-count #!key  (pid (current-process-id )))
;;   (list
;;     (length (glob (conc "/proc/" pid "/fd/*")))
;;     (length  (filter identity (map socket? (glob (conc "/proc/" pid "/fd/*")))))
;;   )
;; )
;;

;; pulled from common_records.scm

;; globals - modules that include this need these here
(define *logging* #f)
(define *functions* (make-hash-table)) ;; symbol => fn ### TEMPORARY!!!
;; (define *toppath* #f)