Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -2367,11 +2367,13 @@ (debug:print 0 *default-log-port* "Failed to create HTML output in " toppath "/lt/runs-index.html")) (set! *didsomething* #t))) (if (args:get-arg "-syscheck") (begin - (mutils:syscheck common:raw-get-remote-host-load) + (mutils:syscheck common:raw-get-remote-host-load + server:get-best-guess-address + read-config) (set! *didsomething* #t))) ;;====================================================================== ;; Exit and clean up ;;====================================================================== Index: mutils/mutils.scm ================================================================== --- mutils/mutils.scm +++ mutils/mutils.scm @@ -22,10 +22,11 @@ ports extras regex posix data-structures + matchable ) (define (mutils:hierhash-ref hh . keys) (if (null? keys) #f @@ -201,23 +202,37 @@ (lambda () (print "You can delete this file"))) (delete-file fname) #t))))) -;; (define (confirm-ssh-access-to-host hostname +(define (run-and-return-output cmd . params) + (let-values (((inp oup pid) + (process cmd params))) + (let ((res (with-input-from-port inp read-lines))) + (let-values (((pidres status estatus) + (process-wait pid))) + (and status (eq? estatus 0) res))))) + +(define (confirm-ssh-access-to-host hostname) + (run-and-return-output "ssh" hostname "uptime")) (define (check-display dsp) + (run-and-return-output "xdpyinfo" "-display" dsp)) + +#;(define (check-display dsp) (let-values (((inp oup pid) (process "xdpyinfo" `("-display" ,dsp)))) (let ((res (with-input-from-port inp read-lines))) (let-values (((pidres status estatus) (process-wait pid))) - (and status (eq? estatus 0)))))) + (and status (eq? estatus 0) res))))) - ;; do some sanity checks on the system +;; do some sanity checks on the system ;; -(define (mutils:syscheck proc) +(define (mutils:syscheck common:raw-get-remote-host-load + server:get-best-guess-address + read-config) ;; current dir writeable and do megatest.config, runconfigs.config files exist/readable (print "Current directory " (current-directory) " writeable: " (if (check-write-create ".") "yes" "NO")) ;; home dir writeable (print "Home directory " (get-environment-variable "HOME") " writeable: " @@ -232,12 +247,58 @@ (print "$DISPLAY accessible? " ;; (eq? (system "xdpyinfo -display $DISPLAY &>/dev/null") 0) (if (check-display (get-environment-variable "DISPLAY")) "yes" "NO")) + (print "Password-less ssh access to localhost: " + (if (confirm-ssh-access-to-host "localhost") + "yes" + "NO")) + + ;; if I'm in a Megatest area do some checks + (print "Have megatest.config: " + (if (file-exists? "megatest.config") + "yes" + "NO")) + + (print "Have runconfigs.config: " + (if (file-exists? "runconfigs.config") + "yes" + "NO")) + + (if (file-exists? ".homehost") + (let* ((homehost (with-input-from-file ".homehost" + read-line)) + (currhost (get-host-name)) + (bestadrs (server:get-best-guess-address currhost))) + (print "Have .homehost and it is the localhost: " + (if (equal? homehost bestadrs) + "yes" + (conc ".homehost=" homehost ", localhost=" bestadrs ", NO"))) + (print "Have .homehost and it is reachable via ssh: " + (if (confirm-ssh-access-to-host homehost) + "yes" + "NO")) + )) + (if (file-exists? "megatest.config") + (let* ((cdat (read-config "megatest.config" #f #f))) + (print "Have [disks] section: " + (if (hash-table-ref/default cdat "disks" #f) + (conc (hash-table-ref cdat "disks") " yes") + "NO")) + (for-each + (lambda (entry) + (match + entry + ((dname path) + (print "Disk " dname " at " path " writeable: " + (if (check-write-create path) "yes" "NO"))) + (else (print "bad entry: " entry)))) + (hash-table-ref/default cdat "disks" '())))) + ;; check load on homehost ;; each run disk read/write ;; link tree writeable ) )