96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
|
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
|
-
+
+
-
-
+
+
+
-
-
+
+
|
(list
(tasks:server-get-server-id mdb (get-host-name) pullport pid)
interface
pullport
pubport))
;; NB// two servers with same pid on different hosts will be removed from the list if pid: is used!
(define (tasks:server-deregister mdb hostname #!key (pullport #f)(pid #f))
(define (tasks:server-deregister mdb hostname #!key (pullport #f)(pid #f)(action 'markdead))
(debug:print-info 11 "server-deregister " hostname ", pullport " pullport ", pid " pid)
(if pid
(case action
;; (sqlite3:execute mdb "DELETE FROM servers WHERE pid=?;" pid)
(sqlite3:execute mdb "UPDATE servers SET state='dead' WHERE pid=?;" pid)
;; (sqlite3:execute mdb "DELETE FROM servers WHERE hostname=? AND port=?;" hostname port)
(sqlite3:execute mdb "UPDATE servers SET state='dead' WHERE hostname=? AND pullport=?;" hostname pullport)
((delete)(sqlite3:execute mdb "DELETE FROM servers WHERE hostname=? AND port=?;" hostname port))
(else (sqlite3:execute mdb "UPDATE servers SET state='dead' WHERE hostname=? AND pullport=?;" hostname pullport)))
(debug:print 0 "ERROR: tasks:server-deregister called with neither pid nor port specified"))))
(define (tasks:server-deregister-self mdb hostname)
(tasks:server-deregister mdb hostname pid: (current-process-id)))
(define (tasks:server-get-server-id mdb hostname pullport pid)
(let ((res #f))
|
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
|
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
|
+
+
-
-
+
+
-
+
|
(if (equal? hostname (get-host-name))
(begin
(debug:print-info 1 "Sending signal/term to " pid " on " hostname)
(process-signal pid signal/term) ;; local machine, send sig term
(thread-sleep! 5) ;; give it five seconds to die peacefully then do a brutal kill
(process-signal pid signal/kill))
(debug:print 0 "WARNING: Can't kill frozen server on remote host " hostname))))))
(define (tasks:get-all-servers mdb)
(let ((res '()))
(sqlite3:for-each-row
(lambda (id pid hostname interface pullport pubport start-time priority state mt-version)
(set! res (cons (vector id pid hostname interface pullport pubport start-time priority state mt-version) res)))
(lambda (id pid hostname interface pullport pubport start-time priority state mt-version last-update)
(set! res (cons (vector id pid hostname interface pullport pubport start-time priority state mt-version last-update) res)))
mdb
"SELECT id,pid,hostname,interface,pullport,pubport,start_time,priority,state,mt_version FROM servers ORDER BY start_time DESC;")
"SELECT id,pid,hostname,interface,pullport,pubport,start_time,priority,state,mt_version,strftime('%s','now')-heartbeat AS last_update FROM servers ORDER BY start_time DESC;")
res))
;;======================================================================
;; Tasks and Task monitors
;;======================================================================
|