20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
|
;;======================================================================
;; Tasks db
;;======================================================================
(define (tasks:open-db)
(let* ((dbpath (conc *toppath* "/monitor.db"))
(exists (file-exists? dbpath))
(mdb (sqlite3:open-database dbpath)) ;; (never-give-up-open-db dbpath))
(handler (make-busy-timeout 36000)))
(sqlite3:set-busy-handler! mdb handler)
(sqlite3:execute mdb (conc "PRAGMA synchronous = 0;"))
(if (not exists)
(begin
(sqlite3:execute mdb "CREATE TABLE IF NOT EXISTS tasks_queue (id INTEGER PRIMARY KEY,
|
|
>
>
>
>
|
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
|
;;======================================================================
;; Tasks db
;;======================================================================
(define (tasks:open-db)
(let* ((dbpath (conc *toppath* "/monitor.db"))
(exists (if (file-exists? dbpath)
;; BUGGISHNESS: Remove this code in six months. Today is 11/13/2012
(if (< (file-change-time dbpath) 1352851396.0)
(begin (delete-file dbpath) #f)
#t) #t))
(mdb (sqlite3:open-database dbpath)) ;; (never-give-up-open-db dbpath))
(handler (make-busy-timeout 36000)))
(sqlite3:set-busy-handler! mdb handler)
(sqlite3:execute mdb (conc "PRAGMA synchronous = 0;"))
(if (not exists)
(begin
(sqlite3:execute mdb "CREATE TABLE IF NOT EXISTS tasks_queue (id INTEGER PRIMARY KEY,
|
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
|
hostname TEXT,
username TEXT,
CONSTRAINT monitors_constraint UNIQUE (pid,hostname));")
(sqlite3:execute mdb "CREATE TABLE IF NOT EXISTS servers (id INTEGER PRIMARY KEY,
pid INTEGER,
interface TEXT,
hostname TEXT,
port INTEGER,
start_time TIMESTAMP,
priority INTEGER,
state TEXT,
mt_version TEXT,
heartbeat TIMESTAMP,
CONSTRAINT servers_constraint UNIQUE (pid,hostname,port));")
(sqlite3:execute mdb "CREATE TABLE IF NOT EXISTS clients (id INTEGER PRIMARY KEY,
|
|
>
|
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
|
hostname TEXT,
username TEXT,
CONSTRAINT monitors_constraint UNIQUE (pid,hostname));")
(sqlite3:execute mdb "CREATE TABLE IF NOT EXISTS servers (id INTEGER PRIMARY KEY,
pid INTEGER,
interface TEXT,
hostname TEXT,
pullport INTEGER,
pubport INTEGER,
start_time TIMESTAMP,
priority INTEGER,
state TEXT,
mt_version TEXT,
heartbeat TIMESTAMP,
CONSTRAINT servers_constraint UNIQUE (pid,hostname,port));")
(sqlite3:execute mdb "CREATE TABLE IF NOT EXISTS clients (id INTEGER PRIMARY KEY,
|
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
188
189
190
191
192
193
194
195
|
(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 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-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))))))))))
(define (tasks:kill-server status hostname port pid)
(debug:print-info 1 "Removing defunct server record for " hostname ":" port)
(if port
(open-run-close tasks:server-deregister tasks:open-db hostname port: port)
(open-run-close tasks:server-deregister tasks:open-db hostname pid: pid))
(if status ;; #t means alive
(begin
|
|
|
|
>
|
|
|
|
|
|
|
>
>
>
>
>
>
>
>
>
|
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
|
(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 2 "Found existing server " hostname ":" port " registered in db"))
mdb
"SELECT id,hostname,interface,pullport,pubport,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 (list-ref hed 0))
(iface (list-ref hed 1))
(pullport (list-ref hed 2))
(pubport (list-ref hed 3))
(pid (list-ref hed 4))
(alive (open-run-close tasks:server-alive? tasks:open-db #f hostname: host pullport: pullport)))
(if alive
(begin
(debug:print-info 2 "Found an existing, alive, server " host ", " pullport " and " pubport ".")
(list host iface pullport pubport))
(begin
(debug:print-info 1 "Marking " host ":" pullport " as dead in server registry.")
(if port
(open-run-close tasks:server-deregister tasks:open-db host pullport: pullport)
(open-run-close tasks:server-deregister tasks:open-db host pid: pid))
(if (null? tal)
#f
(loop (car tal)(cdr tal))))))))))
(define (tasks:mark-server hostname pullport pid state)
(if port
(open-run-close tasks:server-deregister tasks:open-db hostname port: port)
(open-run-close tasks:server-deregister tasks:open-db hostname pid: pid)))
;; NOTE: NOT PORTED TO WORK WITH pullport/pubport
(define (tasks:kill-server status hostname port pid)
(debug:print-info 1 "Removing defunct server record for " hostname ":" port)
(if port
(open-run-close tasks:server-deregister tasks:open-db hostname port: port)
(open-run-close tasks:server-deregister tasks:open-db hostname pid: pid))
(if status ;; #t means alive
(begin
|