Megatest

	  srfi-1
	  ;; srfi-13
	  srfi-69
	  ;; ports
	  extras
	  regex
	  posix
	  data-structures
	  )

(define (mutils:hierhash-ref hh . keys)
  (if (null? keys)
      #f
      (let loop ((ht   hh)
		 (key  (car keys))

       (if (null? @path) @hierlist
	   (apply mutils:hier-list-get @hierlist @path))))

;;======================================================================
;; Other utils
;;======================================================================

#;(define (check-write-create fpath)
(define (check-write-create fpath)
  (and (file-write-access? fpath)
       (let ((fname (conc fpath "/junk ". (current-seconds) "-" (random 10000))))
	 (print "trying to create/remove " fname)
       (let ((fname (conc fpath "/.junk-" (current-seconds) "-" (random 10000))))
	 ;;(print "trying to create/remove " fname)
	 (handle-exceptions
	  exn
	  #f
	  (begin
	    (with-output-to-file fname
	      (lambda ()
		(print "You can delete this file")))
	    (delete-file fname)
	    #t)))))

;; (define (confirm-ssh-access-to-host hostname)
  

;; do some sanity checks on the system
;;
(define (mutils:syscheck)
(define (mutils:syscheck proc)
  ;; current dir writeable and do megatest.config, runconfigs.config files exist/readable
  (print "Current directory " (current-directory) " writeable: " 
	 (if #;(check-file-create ".")
	 (if (check-write-create ".") "yes" "NO"))
	  (file-write-access? ".")"yes" "no"))
  ;; home dir writeable
  (print "Home directory " (get-environment-variable "HOME") " writeable: "
	 (if (check-write-create (get-environment-variable "HOME")) "yes" "NO"))
  ;; /tmp writeable
  (print "/tmp directory writeable: " (if (check-write-create "/tmp") "yes" "NO"))
  ;; load configs
  (print "$DISPLAY set: " (if (get-environment-variable "DISPLAY")
			      (conc  (get-environment-variable "DISPLAY") " yes")
			      "NO"))

  (print "$DISPLAY accessible? "
	 (if (eq? (system "xdpyinfo -display $DISPLAY &>/dev/null;") 0)
	     "yes" "NO"))


  ;;    check load on homehost
  ;;    each run disk read/write
  ;;    link tree writeable
  )
  
)