Megatest

Diff
Login

Differences From Artifact [4d4a2441c8]:

To Artifact [2d53221a69]:


20
21
22
23
24
25
26
27

28
29
30
31


32

33
34
35
36
37
38
39
20
21
22
23
24
25
26

27
28
29
30
31
32
33

34
35
36
37
38
39
40
41







-
+




+
+
-
+








(use srfi-1 data-structures posix regex-case (prefix base64 base64:)
     format dot-locking csv-xml z3 udp ;; sql-de-lite
     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:)
     (prefix dbi dbi:)
     )

(declare (unit common))
(declare (uses commonmod))
(import (prefix commonmod cmod:))

(import commonmod)
(import pkts)

(include "common_records.scm")


;; (require-library margs)
;; (include "margs.scm")

871
872
873
874
875
876
877
878
879
880
881

882
883
884
885
886
887
888
889
890
873
874
875
876
877
878
879




880


881
882
883
884
885
886
887







-
-
-
-
+
-
-







    (if val val default)))

(define (assoc/default key lst . default)
  (let ((res (assoc key lst)))
    (if res (cadr res)(if (null? default) #f (car default)))))

(define (common:get-testsuite-name)
  (or (configf:lookup *configdat* "setup" "area-name") ;; megatest is a flexible tool, testsuite is too limiting a description.
      (configf:lookup *configdat* "setup" "testsuite" )
      (getenv "MT_TESTSUITE_NAME")
      (if (string? *toppath* )
  (cmod:get-testsuite-name *toppath* *configdat*))
          (pathname-file *toppath*)
          #f))) ;; (pathname-file (current-directory)))))

;; safe getting of toppath
(define (common:get-toppath areapath)
  (or *toppath*
      (if areapath
	  (begin
	    (set! *toppath* areapath)
1730
1731
1732
1733
1734
1735
1736
1737









1738
1739
1740
1741
1742
1743
1744
1727
1728
1729
1730
1731
1732
1733

1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749







-
+
+
+
+
+
+
+
+
+







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