Megatest

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

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

(use srfi-1 data-structures posix regex-case (prefix base64 base64:)
     format dot-locking csv-xml z3 ;; sql-de-lite
     s11n hostinfo md5 message-digest typed-records directory-utils stack
     matchable regex posix (srfi 18) extras ;; tcp 
     (prefix nanomsg nmsg:)
     (prefix sqlite3 sqlite3:)
     pkts (prefix dbi dbi:)
     )

(declare (unit common))

    (with-input-from-pipe
	(conc "/bin/readlink -f " path)
      (lambda ()
	(read-line)))))

(define (get-cpu-load #!key (remote-host #f))
  (car (common:get-cpu-load remote-host)))

(define (get-cpu-load-original #!key (remote-host #f))
  (car (common:get-cpu-load-original remote-host)))
;;   (let* ((load-res (process:cmd-run->list "uptime"))
;; 	 (load-rx  (regexp "load average:\\s+(\\d+)"))
;; 	 (cpu-load #f))
;;     (for-each (lambda (l)
;; 		(let ((match (string-search load-rx l)))
;; 		  (if match
;; 		      (let ((newval (string->number (cadr match))))

(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))))))

(define (common:get-cpu-load remote-host)
  (let ((al (common:get-normalized-cpu-load remote-host)))
  (list (alist-ref '1m-load al) (alist-ref '5m-load al) (alist-ref '15m-load al)))
  ;;(common:get-cpu-load-original remote-host)
)
;; get cpu load by reading from /proc/loadavg, return all three values
;;
(define (common:get-cpu-load-original remote-host)
  (let* ((actual-hostname (or remote-host (get-host-name) "localhost")))
    (or (common:get-cached-info actual-hostname "cpu-load")
	(let ((result (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)))))))
	  (common:write-cached-info actual-hostname "cpu-load" result)
	  result))))

;; 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)
  (if (file-exists? (pathname-expand "~/.megatest/tquery"))
    (begin
    (with-input-from-file (pathname-expand "~/.megatest/tquery")
      (lambda()
        (set! tqfilecontents (read-string))
      ))
    (set! tqfileparts (string-split (string-trim-both tqfilecontents) ":"))
    ;;(print "TQuery host: " (car tqfileparts)) 
    ;;(print "TQuery port " (cadr tqfileparts))
    ;;(print "Getting normalized cpu load for : " remote-host " via " (car tqfileparts) ":" (cadr tqfileparts))
    )
    (begin
      (process-run "nbfake /p/fdk/gwa/jmoon18/fossil/megatest/tquery -server -")
      (sleep 5)
    )
  )
  (handle-exceptions exn 
    (lambda()
      ;;(print "Need to start tquery server here:")
      (process-run "nbfake /p/fdk/gwa/jmoon18/fossil/megatest/tquery -server -")
      (sleep 5)
      (common:get-normalized-cpu-load remote-host)
    )
    (define-values (i o) (tcp-connect (car tqfileparts) (string->number (cadr tqfileparts)))) 
    ;;(define-values (i o) (tcp-connect "plxcas102" 9000)) 
    (write-line (conc "adj-cpuload-full:" (if remote-host remote-host (get-host-name))) o) 
    ;;(write-line "adj-cpuload-full:plxcm5005" o) 
    (with-input-from-string (read-line i) read)
  )

  ;;(define new-al with-input-from-string (read-line i) read)
  ;;new-al
  ;;(set! loadstring (read-string i))
  ;;(with-input-from-string loadstring read)  
  ;;`((adj-proc-load 3.0)
  ;;  (adj-core-load 3.2))
)


(define (common:get-normalized-cpu-load-original remote-host)
  (let ((res (common:get-normalized-cpu-load-raw-original remote-host))
	(default `((adj-proc-load . 2) ;; there is no right answer
		   (adj-core-load . 2)
		   (1m-load       . 2)
		   (5m-load       . 0) ;; causes a large delta - thus causing default of throttling if stuff goes wrong
		   (15m-load      . 0)
		   (proc          . 1)
		   (core          . 1)
		   (phys          . 1)
		   (error         . #t))))
    (cond
     ((and (list? res)
	   (> (length res) 2))
      res)
     ((eq? res #f)   default) ;; add messages?
     ((eq? res #f) default)   ;; this would be the #eof
     (else default))))

(define (common:get-normalized-cpu-load-raw-original remote-host)
  (let* ((actual-host (or remote-host (get-host-name)))) ;; #f is localhost
    (or (common:get-cached-info actual-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 

                     #f
                     (common:get-homehost)))
         (hh     (if hh-dat (car hh-dat) #f))
         (numcpus (common:get-num-cpus hh)))
    (common:wait-for-normalized-load maxload msg hh)))

(define (common:get-num-cpus remote-host)
  (alist-ref 'core (common:get-normalized-cpu-load remote-host))
)

(define (common:get-num-cpus-orig remote-host)
  (let* ((actual-host (or remote-host (get-host-name))))
    (or (common:get-cached-info actual-host "num-cpus" age: 86400) ;; hosts had better not be changing the number of cpus too often!
	(let* ((proc   (lambda ()
			 (let loop ((numcpu 0)
				    (inl    (read-line)))
			   (if (eof-object? inl)
			       (begin