Megatest

# make install CSCOPTS='-accumulate-profile -profile-name $(PWD)/profile-ww$(shell date +%V.%u)'
# rm <files>.o ; make install CSCOPTS='-profile' ; ... ;  chicken-profile | less
SHELL=/bin/bash
PREFIX=$(PWD)
CSCOPTS=
INSTALL=install
SRCFILES = common.scm items.scm launch.scm \
   ods.scm runconfig.scm server.scm configf.scm \
   db.scm keys.scm margs.scm megatest-version.scm \
   process.scm runs.scm tasks.scm tests.scm genexample.scm \

;; 		(let ((match (string-search load-rx l)))
;; 		  (if match
;; 		      (let ((newval (string->number (cadr match))))
;; 			(if (number? newval)
;; 			    (set! cpu-load newval))))))
;; 	      (car load-res))
;;     cpu-load))

;; get values from cached info from dropping file in logs dir
;;  e.g. key is host and dtype is normalized-load
;;
(define (common:get-cached-info key dtype #!key (age 3))
  (let* ((fullpath (conc *toppath* "/logs/" key "-" dtype ".log")))
    (if (and (file-exists? fullpath)
	     (file-read-access? fullpath))
	(handle-exceptions
	 exn
	 #f
	 (print "reading file " fullpath)
	 (let ((real-age (- (current-seconds)(file-change-time fullpath)))) 
	   (if (< real-age age)
	       (with-input-from-file fullpath read)
	       (begin
		 (print "file " fullpath " is too old (" real-age" seconds)to trust, skipping reading it")
		 #f))))
	(begin
	  (print "not reading file " fullpath)
	  #f))))
 
(define (common:write-cached-info key dtype dat)
  (let* ((fullpath (conc *toppath* "/logs/" key "-" dtype ".log")))
    (handle-exceptions
     exn
     #f
     (with-output-to-file fullpath (lambda ()(pp dat))))))

;; get cpu load by reading from /proc/loadavg, return all three values
;;
(define (common:get-cpu-load remote-host)
  (if remote-host
      (map (lambda (res)
	     (if (eof-object? res) 9e99 res))
	   (with-input-from-pipe 
	    (conc "ssh " remote-host " cat /proc/loadavg")
	    (lambda ()(list (read)(read)(read)))))
      (with-input-from-file "/proc/loadavg" 
	(lambda ()(list (read)(read)(read))))))

;; get normalized cpu load by reading from /proc/loadavg and /proc/cpuinfo return all three values and the number of real cpus and the number of threads
;; returns alist '((adj-cpu-load . normalized-proc-load) ... etc.
;;  keys: adj-proc-load, adj-core-load, 1m-load, 5m-load, 15m-load
;;
(define (common:get-normalized-cpu-load remote-host)
  (or (common:get-cached-info remote-host "normalized-load")
      (let ((data (if remote-host
		      (with-input-from-pipe 
		       (conc "ssh " remote-host " cat /proc/loadavg;cat /proc/cpuinfo;echo end")
		       read-lines)
		      (append 
		       (with-input-from-file "/proc/loadavg" 
			 read-lines)
		       (with-input-from-file "/proc/cpuinfo"
			 read-lines)
		       (list "end"))))
	    (load-rx  (regexp "^([\\d\\.]+)\\s+([\\d\\.]+)\\s+([\\d\\.]+)\\s+.*$"))
	    (proc-rx  (regexp "^processor\\s+:\\s+(\\d+)\\s*$"))
	    (core-rx  (regexp "^core id\\s+:\\s+(\\d+)\\s*$"))
	    (phys-rx  (regexp "^physical id\\s+:\\s+(\\d+)\\s*$"))
	    (max-num  (lambda (p n)(max (string->number p) n))))
	;; (print "data=" data)
	(if (null? data) ;; something went wrong
	    #f
	    (let loop ((hed      (car data))
		       (tal      (cdr data))
		       (loads    #f)
		       (proc-num 0)  ;; processor includes threads
		       (phys-num 0)  ;; physical chip on motherboard
		       (core-num 0)) ;; core
	      ;; (print hed ", " loads ", " proc-num ", " phys-num ", " core-num)
	      (if (null? tal) ;; have all our data, calculate normalized load and return result
		  (let* ((act-proc (+ proc-num 1))
			 (act-phys (+ phys-num 1))
			 (act-core (+ core-num 1))
			 (adj-proc-load (/ (car loads) act-proc))
			 (adj-core-load (/ (car loads) act-core))
			 (result
			  (append (list (cons 'adj-proc-load adj-proc-load)
					(cons 'adj-core-load adj-core-load))
				  (list (cons '1m-load (car loads))
					(cons '5m-load (cadr loads))
					(cons '15m-load (caddr loads)))
				  (list (cons 'proc act-proc)
					(cons 'core act-core)
					(cons 'phys act-phys)))))
		    (common:write-cached-info remote-host "normalized-load" result)
		    result)
		  (regex-case
		   hed
		   (load-rx  ( x l1 l5 l15 ) (loop (car tal)(cdr tal)(map string->number (list l1 l5 l15)) proc-num phys-num core-num))
		   (proc-rx  ( x p         ) (loop (car tal)(cdr tal) loads           (max-num p proc-num) phys-num core-num))
		   (phys-rx  ( x p         ) (loop (car tal)(cdr tal) loads           proc-num (max-num p phys-num) core-num))
		   (core-rx  ( x c         ) (loop (car tal)(cdr tal) loads           proc-num phys-num (max-num c core-num)))
		   (else 
		    (begin
		      ;; (print "NO MATCH: " hed)
		      (loop (car tal)(cdr tal) loads proc-num phys-num core-num))))))))))

(define (common:unix-ping hostname)
  (let ((res (system (conc "ping -c 1 " hostname " > /dev/null"))))
    (eq? res 0)))

;; ideally put all this info into the db, no need to preserve it across moving homehost
;;