Overview
| Comment: | Merged f02d97 and 55a9a, mostly syscheck stuff |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.65-newbuild |
| Files: | files | file ages | folders |
| SHA1: |
88b411ff1e44194a41467d3700a9ebd3 |
| User & Date: | mrwellan on 2020-05-26 18:30:46 |
| Other Links: | branch diff | manifest | tags |
Context
|
2020-05-26
| ||
| 18:33 | Cherrypicked 2c225 and b82fd, syscheck stuff check-in: 23c3e9a0ba user: mrwellan tags: v1.65-newbuild | |
| 18:30 | Merged f02d97 and 55a9a, mostly syscheck stuff check-in: 88b411ff1e user: mrwellan tags: v1.65-newbuild | |
| 18:28 | Cherrypicked 4c2b. NOTE: Includes -syscheck check-in: e9d3ab5e85 user: mrwellan tags: v1.65-newbuild | |
Changes
Modified common.scm from [fb61d644f4] to [79eab84e44].
| ︙ | ︙ | |||
1731 1732 1733 1734 1735 1736 1737 |
(fullpath (conc fulldir "/" key "-" dtype ".log")))
(if (not (file-exists? fulldir))(create-directory fulldir #t))
(handle-exceptions
exn
#f
(with-output-to-file fullpath (lambda ()(pp dat)))))
#f))
| | > > > > > > > > | 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 |
(fullpath (conc fulldir "/" key "-" dtype ".log")))
(if (not (file-exists? fulldir))(create-directory fulldir #t))
(handle-exceptions
exn
#f
(with-output-to-file fullpath (lambda ()(pp dat)))))
#f))
(define (common:raw-get-remote-host-load remote-host)
(handle-exceptions
exn
#f ;; more specific handling of errors needed
(with-input-from-pipe
(conc "ssh " remote-host " cat /proc/loadavg")
(lambda ()(list (read)(read)(read))))))
;; get cpu load by reading from /proc/loadavg, return all three values
;;
(define (common:get-cpu-load remote-host)
(handle-exceptions
exn
'(99 99 99)
(let* ((actual-hostname (or remote-host (get-host-name) "localhost")))
|
| ︙ | ︙ |
Modified megatest.scm from [74b08ec25f] to [dc26c13c4e].
| ︙ | ︙ | |||
2365 2366 2367 2368 2369 2370 2371 |
(if (tests:create-html-summary #f)
(debug:print-info 0 *default-log-port* "HTML output created in " toppath "/lt/targets.html")
(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
| | | 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 |
(if (tests:create-html-summary #f)
(debug:print-info 0 *default-log-port* "HTML output created in " toppath "/lt/targets.html")
(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)
(set! *didsomething* #t)))
;;======================================================================
;; Exit and clean up
;;======================================================================
(if (not *didsomething*)
|
| ︙ | ︙ |
Modified mutils/mutils.scm from [ded5dc300c] to [06aac990f8].
| ︙ | ︙ | |||
19 20 21 22 23 24 25 26 27 28 29 30 31 32 |
srfi-1
;; srfi-13
srfi-69
;; ports
extras
regex
posix
)
(define (mutils:hierhash-ref hh . keys)
(if (null? keys)
#f
(let loop ((ht hh)
(key (car keys))
| > | 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 |
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))
|
| ︙ | ︙ | |||
184 185 186 187 188 189 190 |
(if (null? @path) @hierlist
(apply mutils:hier-list-get @hierlist @path))))
;;======================================================================
;; Other utils
;;======================================================================
| | | | > > > | | < > > > > > > > > > > > > > | 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 |
(if (null? @path) @hierlist
(apply mutils:hier-list-get @hierlist @path))))
;;======================================================================
;; Other utils
;;======================================================================
(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)
(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 proc)
;; 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: "
(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
)
)
|