Megatest

;; re-read the db over and over again for the keys since they never
;; change

;; why get the keys from the db? why not get from the *configdat*
;; using keys:config-get-fields?

(define (db:get-keys dbstruct)
  (keys:config-get-fields *configdat*)
)
  (if *db-keys* *db-keys* 
      (let ((res '()))
	(db:with-db dbstruct #f #f
		    (lambda (dbdat db)
		      (sqlite3:for-each-row 
		       (lambda (key)
			 (set! res (cons key res)))
		       db
		       "SELECT fieldname FROM keys ORDER BY id DESC;")))
	(set! *db-keys* res)
	res)))
;;  (if *db-keys* *db-keys* 
;;      (let ((res '()))
;;	(db:with-db dbstruct #f #f
;;		    (lambda (dbdat db)
;;		      (sqlite3:for-each-row 
;;		       (lambda (key)
;;			 (set! res (cons key res)))
;;		       db
;;		       "SELECT fieldname FROM keys ORDER BY id DESC;")))
;;	(set! *db-keys* res)
;;	res)))

;; extract index number given a header/data structure
(define (db:get-index-by-header header field)
  (list-index (lambda (x)(equal? x field)) header))

;; look up values in a header/data structure
(define (db:get-value-by-header row header field)

	   (retry))
      (exn (permission)(dbfile:print-err exn "ERROR: database " fname " has some permissions problem.")
	   (retry))
      (exn ()
	   (dbfile:print-err exn "ERROR: Unknown error with database " fname " message: "
			     ((condition-property-accessor 'exn 'message) exn))
	   (retry)))))
          ;; (if (file-write-access? fname) -- stuff lost in merge, what was here?
          ;; )

(define (dbfile:open-no-sync-db dbpath)
  (if (not (file-exists? dbpath))
      (create-directory dbpath #t))
  (let* ((dbname    (conc dbpath "/no-sync.db"))
	 (db-exists (file-exists? dbname))
	 (db        (dbfile:cautious-open-database dbname)))

         (file-list (if (eq? 0 (length glob-list))
			'("/no/such/file")
			glob-list)))
  (apply max
	 (map
	  dbfile:lazy-modification-time 
	  file-list))))


)
)

      (set! *didsomething* #t)))

(if (or (args:get-arg "-list-servers")
        (args:get-arg "-kill-servers"))
    (let ((tl (launch:setup)))
      (if tl ;; all roads from here exit
	  (let* ((servers (server:get-list *toppath*))
		 (fmtstr  "~8a~22a~20a~20a~8a\n"))
	    (format #t fmtstr "pid" "Interface:port" "age (hms)" "Last mod" "State")
	    (format #t fmtstr "===" "==============" "=========" "========" "=====")
		 (fmtstr  "~33a~22a~20a~20a~8a\n"))
	    (format #t fmtstr "ID" "host:port" "age (hms)" "Last mod" "State")
	    (format #t fmtstr "==" "=========" "=========" "========" "=====")
	    (for-each ;;  ( mod-time host port start-time pid )
	     (lambda (server)
	       (let* ((mtm (any->number (car server)))
		      (mod (if mtm (- (current-seconds) mtm) "unk"))
		      (age (- (current-seconds)(or (any->number (list-ref server 3)) (current-seconds))))
		      (url (conc (cadr server) ":" (caddr server)))
		      (pid (list-ref server 4))