Megatest

(declare (uses mtver))
(declare (uses debugprint))
(declare (uses stml2))
(declare (uses pkts))
(declare (uses processmod))
(declare (uses mtargs))
(declare (uses configfmod))
;; (declare (uses hostinfo))
(declare (uses keysmod))

;; odd but it works?
;; (declare (uses itemsmod))

(module commonmod
	   (

	chicken.io
	chicken.string
	chicken.sort
	chicken.time.posix
	
	(prefix base64 base64:)
	(prefix sqlite3 sqlite3:)

	address-info
	directory-utils
	matchable
	md5
	message-digest
	regex
	regex-case
	sparse-vectors

	stml2
	pkts
	processmod
	(prefix mtargs args:)
	configfmod
	keysmod
	;; itemsmod
	;; hostinfo
	)

;;======================================================================
;; CONTENTS
;;
;;  config file utils
;;  misc conversion, data manipulation functions

		  d
		  (begin
		    ;; (if (common:low-noise-print 60 "tests:get-tests-search-path" d)
		    ;;	(debug:print 0 *default-log-port* "WARNING: problem with directory " d ", dropping it from tests path"))
		    #f)))
	    (append paths (list (conc *toppath* "/tests"))))))

;;======================================================================
;; network utilities
;;======================================================================

#;(define (server:get-best-guess-address hostname)
  (let ((res #f))
    (for-each 
     (lambda (adr)
       (if (not (eq? (u8vector-ref adr 0) 127))
	   (set! res adr)))
     ;; NOTE: This can fail when there is no mention of the host in /etc/hosts. FIXME
     (vector->list (hostinfo-addresses (hostname->hostinfo hostname))))
    (string-intersperse 
     (map number->string
	  (u8vector->list
	   (if res res (hostname->ip hostname)))) ".")))

;; NOTE: Look at address-info egg as alternative to some of this

(define (rate-ip ipaddr)
  (regex-case ipaddr
    ( "^127\\..*" _ 0 )
    ( "^(10\\.0|192\\.168)\\..*" _ 1 )
    ( else 2 ) ))

;; Change this to bias for addresses with a reasonable broadcast value?
;;
(define (ip-pref-less? a b)
  (> (rate-ip a) (rate-ip b)))

(define (server:get-best-guess-address hostname)
  (let ((all-addresses (get-all-ips hostname)))
    (cond
     ((null? all-addresses)
      hostname #;(get-host-name))                                          ;; no interfaces?
     ((eq? (length all-addresses) 1)
      (car all-addresses))                      ;; only one to choose from, just go with it
     (else
      (car (sort all-addresses ip-pref-less?))))))

(define (get-all-ips-sorted)
  (sort (get-all-ips) ip-pref-less?))

(define (get-all-ips hostname)
  (map address-info-host
       (filter (lambda (x)
		 (equal? (address-info-type x) 'tcp))
	       (address-infos hostname))))

(define (tests:readlines filename)
  (call-with-input-file filename
    (lambda (p)
      (let loop ((line (read-line p))
                 (result '()))
        (if (eof-object? line)