Megatest

Check-in [632d164e99]
Login
Overview
Comment:Minor clean up of messages from server
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk | v1.5109
Files: files | file ages | folders
SHA1: 632d164e99a32502042877304bc12f6cd3d51818
User & Date: mrwellan on 2012-11-05 10:49:31
Other Links: manifest | tags
Context
2012-11-05
13:20
Added catching of ^c and flushing of server communication so that server doesn't die check-in: bb324e0945 user: mrwellan tags: trunk, v1.5110
10:49
Minor clean up of messages from server check-in: 632d164e99 user: mrwellan tags: trunk, v1.5109
10:21
Bumped version, reduced noise from the server process in normal debug mode check-in: 5043b0da9e user: mrwellan tags: trunk, v1.5109
Changes

Modified tasks.scm from [15052bf640] to [53e3d6e8bd].

158
159
160
161
162
163
164
165

166
167
168
169
170
171
172
173
174
175
176
177
178
179
180

181
182
183
184
185
186
187
158
159
160
161
162
163
164

165
166
167
168
169
170
171
172
173
174
175
176
177
178
179

180
181
182
183
184
185
186
187







-
+














-
+







;; remove any others. will not necessarily remove all!
(define (tasks:get-best-server mdb)
  (let ((res '())
	(best #f))
    (sqlite3:for-each-row
     (lambda (id hostname interface port pid)
       (set! res (cons (list hostname interface port pid) res))
       (debug:print-info 1 "Found existing server " hostname ":" port " registered in db"))
       (debug:print-info 2 "Found existing server " hostname ":" port " registered in db"))
     mdb
     "SELECT id,hostname,interface,port,pid FROM servers WHERE state='live' AND mt_version=? ORDER BY start_time ASC LIMIT 1;" megatest-version)
    ;; (print "res=" res)
    (if (null? res) #f
	(let loop ((hed (car res))
		   (tal (cdr res)))
	  ;; (print "hed=" hed ", tal=" tal)
	  (let* ((host     (car    hed))
		 (iface    (cadr   hed))
		 (port     (caddr  hed))
		 (pid      (cadddr hed))
		 (alive    (open-run-close tasks:server-alive? tasks:open-db #f hostname: host port: port)))
	    (if alive
		(begin
		  (debug:print 1 "Found an existing, alive, server " host ":" port ".")
		  (debug:print-info 2 "Found an existing, alive, server " host ":" port ".")
		  (list host iface port))
		(begin
		  (debug:print-info 1 "Removing " host ":" port " from server registry as it appears to be dead")
		  (tasks:kill-server #f host port pid)
		  (if (null? tal)
		      #f
		      (loop (car tal)(cdr tal))))))))))