Overview
Comment: | Cherrypicked 2c225 and b82fd, syscheck stuff |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.65-newbuild |
Files: | files | file ages | folders |
SHA1: |
23c3e9a0badfde539502d123fff286d1 |
User & Date: | mrwellan on 2020-05-26 18:33:10 |
Other Links: | branch diff | manifest | tags |
Context
2020-05-26
| ||
18:35 | Cherrypicked caed2ec check-in: 3bc8aefeaf user: mrwellan tags: v1.65-newbuild | |
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 | |
Changes
Modified megatest.scm from [dc26c13c4e] to [79dae659e5].
︙ | ︙ | |||
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 2380 2381 | (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 server:get-best-guess-address read-config) (set! *didsomething* #t))) ;;====================================================================== ;; Exit and clean up ;;====================================================================== (if (not *didsomething*) |
︙ | ︙ |
Modified mutils/mutils.scm from [06aac990f8] to [d8d310a6fa].
︙ | ︙ | |||
15 16 17 18 19 20 21 | * (import chicken scheme ;; data-structures posix srfi-1 ;; srfi-13 srfi-69 | | > | 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 | * (import chicken scheme ;; data-structures posix srfi-1 ;; srfi-13 srfi-69 ports extras regex posix data-structures matchable ) (define (mutils:hierhash-ref hh . keys) (if (null? keys) #f (let loop ((ht hh) (key (car keys)) |
︙ | ︙ | |||
199 200 201 202 203 204 205 | (begin (with-output-to-file fname (lambda () (print "You can delete this file"))) (delete-file fname) #t))))) | > > > > > > > > | > | > > > > > > > > > > | > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > < | 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 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 | (begin (with-output-to-file fname (lambda () (print "You can delete this file"))) (delete-file fname) #t))))) (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) res))))) ;; do some sanity checks on the system ;; (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: " (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? " ;; (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" '())))) (print "Have link tree and it is writable: " (if (and (file-exists? "lt") (check-write-create "lt")) "yes" "NO")) ;; check load on homehost ;; link tree writeable ) ) |