Megatest

Check-in [40aac4386e]
Login
Overview
Comment:don't ssh to current host
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.80
Files: files | file ages | folders
SHA1: 40aac4386e410869a9a9829b94d9d4e1a2600a66
User & Date: mrwellan on 2023-06-14 14:55:49
Other Links: branch diff | manifest | tags
Context
2023-06-27
09:08
Fixed quote in path issue check-in: 8ff6166610 user: mrwellan tags: v1.80, v1.8014
2023-06-14
14:55
don't ssh to current host check-in: 40aac4386e user: mrwellan tags: v1.80
09:40
Minor updates to documentation check-in: 708efdc9e4 user: mrwellan tags: v1.80
Changes

Modified common.scm from [4943a8edf6] to [49557c29a9].

1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1737
1738
1739
1740
1741
1742
1743










1744
1745
1746
1747
1748
1749
1750







-
-
-
-
-
-
-
-
-
-







	    exn
	  (begin
	    (debug:print 0 *default-log-port* "failed to write file " fullpath ", exn=" exn)
	    #f)
	  (with-output-to-file fullpath (lambda ()(pp dat)))))
      #f))

(define (common:raw-get-remote-host-load-orig remote-host)
  (handle-exceptions
      exn
    (begin
      (debug:print 0 *default-log-port* "failed to ssh to " remote-host " and get loadavg. exn=" exn)
      #f) ;; more specific handling of errors needed
    (with-input-from-pipe 
     (conc "ssh " remote-host " cat /proc/loadavg")
     (lambda ()(list (read)(read)(read))))))

(define (common:raw-get-remote-host-load remote-host)
  (let* ((inp #f))
    (handle-exceptions
	exn
      (begin
	(close-input-pipe inp)
	(debug:print 0 *default-log-port* "failed to ssh to " remote-host " and get loadavg. exn=" exn)
1771
1772
1773
1774
1775
1776
1777
1778


1779
1780
1781
1782
1783
1784
1785
1761
1762
1763
1764
1765
1766
1767

1768
1769
1770
1771
1772
1773
1774
1775
1776







-
+
+







  (handle-exceptions
      exn
    (begin
      (debug:print 0 *default-log-port* "failed to ssh or read loadavg from host " remote-host ", exn=" exn)
      '(-99 -99 -99))
    (let* ((actual-hostname (or remote-host (get-host-name) "localhost")))
      (or (common:get-cached-info actual-hostname "cpu-load")
	  (let ((result (if remote-host
	  (let ((result (if (and remote-host
				 (not (equal? remote-host (get-host-name))))
			    (map (lambda (res)
				   (if (eof-object? res) 9e99 res))
			         (common:raw-get-remote-host-load remote-host))
			    (with-input-from-file "/proc/loadavg" 
			      (lambda ()(list (read)(read)(read)))))))
	    (match
		result
2034
2035
2036
2037
2038
2039
2040
2041


2042
2043
2044
2045
2046
2047
2048
2025
2026
2027
2028
2029
2030
2031

2032
2033
2034
2035
2036
2037
2038
2039
2040







-
+
+







						   (if (> numcpu 0)
						       numcpu
						       #f) ;; if zero return #f so caller knows that things are not working
						   (loop (if (string-match "^processor\\s+:\\s+\\d+$" inl)
							     (+ numcpu 1)
							     numcpu)
							 (read-line))))))
				   (result (if remote-host
				   (result (if (and remote-host
						    (not (equal? remote-host (get-host-name))))
					       (common:generic-ssh
						(conc "ssh " remote-host " cat /proc/cpuinfo")
						proc -1)
					       (with-input-from-file "/proc/cpuinfo" proc))))
			      (if (and (number? result)
				       (> result 0))
				  (common:write-cached-info actual-host "num-cpus" result))