0000: 3b 3b 20 43 6f 70 79 72 69 67 68 74 20 32 30 30 ;; Copyright 200
0010: 36 2d 32 30 31 32 2c 20 4d 61 74 74 68 65 77 20 6-2012, Matthew
0020: 57 65 6c 6c 61 6e 64 2e 0a 3b 3b 20 0a 3b 3b 20 Welland..;; .;;
0030: 20 54 68 69 73 20 70 72 6f 67 72 61 6d 20 69 73 This program is
0040: 20 6d 61 64 65 20 61 76 61 69 6c 61 62 6c 65 20 made available
0050: 75 6e 64 65 72 20 74 68 65 20 47 4e 55 20 47 50 under the GNU GP
0060: 4c 20 76 65 72 73 69 6f 6e 20 32 2e 30 20 6f 72 L version 2.0 or
0070: 0a 3b 3b 20 20 67 72 65 61 74 65 72 2e 20 53 65 .;; greater. Se
0080: 65 20 74 68 65 20 61 63 63 6f 6d 70 61 6e 79 69 e the accompanyi
0090: 6e 67 20 66 69 6c 65 20 43 4f 50 59 49 4e 47 20 ng file COPYING
00a0: 66 6f 72 20 64 65 74 61 69 6c 73 2e 0a 3b 3b 20 for details..;;
00b0: 0a 3b 3b 20 20 54 68 69 73 20 70 72 6f 67 72 61 .;; This progra
00c0: 6d 20 69 73 20 64 69 73 74 72 69 62 75 74 65 64 m is distributed
00d0: 20 57 49 54 48 4f 55 54 20 41 4e 59 20 57 41 52 WITHOUT ANY WAR
00e0: 52 41 4e 54 59 3b 20 77 69 74 68 6f 75 74 20 65 RANTY; without e
00f0: 76 65 6e 20 74 68 65 0a 3b 3b 20 20 69 6d 70 6c ven the.;; impl
0100: 69 65 64 20 77 61 72 72 61 6e 74 79 20 6f 66 20 ied warranty of
0110: 4d 45 52 43 48 41 4e 54 41 42 49 4c 49 54 59 20 MERCHANTABILITY
0120: 6f 72 20 46 49 54 4e 45 53 53 20 46 4f 52 20 41 or FITNESS FOR A
0130: 20 50 41 52 54 49 43 55 4c 41 52 0a 3b 3b 20 20 PARTICULAR.;;
0140: 50 55 52 50 4f 53 45 2e 0a 0a 3b 3b 20 20 73 74 PURPOSE...;; st
0150: 72 66 74 69 6d 65 28 27 25 6d 2f 25 64 2f 25 59 rftime('%m/%d/%Y
0160: 20 25 48 3a 25 4d 3a 25 53 27 2c 27 6e 6f 77 27 %H:%M:%S','now'
0170: 2c 27 6c 6f 63 61 6c 74 69 6d 65 27 29 0a 0a 28 ,'localtime')..(
0180: 75 73 65 20 73 71 6c 69 74 65 33 20 73 72 66 69 use sqlite3 srfi
0190: 2d 31 20 70 6f 73 69 78 20 72 65 67 65 78 20 72 -1 posix regex r
01a0: 65 67 65 78 2d 63 61 73 65 20 73 72 66 69 2d 36 egex-case srfi-6
01b0: 39 20 64 6f 74 2d 6c 6f 63 6b 69 6e 67 20 66 6f 9 dot-locking fo
01c0: 72 6d 61 74 29 0a 28 69 6d 70 6f 72 74 20 28 70 rmat).(import (p
01d0: 72 65 66 69 78 20 73 71 6c 69 74 65 33 20 73 71 refix sqlite3 sq
01e0: 6c 69 74 65 33 3a 29 29 0a 0a 28 64 65 63 6c 61 lite3:))..(decla
01f0: 72 65 20 28 75 6e 69 74 20 74 61 73 6b 73 29 29 re (unit tasks))
0200: 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 .(declare (uses
0210: 64 62 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 db)).(declare (u
0220: 73 65 73 20 63 6f 6d 6d 6f 6e 29 29 0a 0a 28 69 ses common))..(i
0230: 6e 63 6c 75 64 65 20 22 74 61 73 6b 5f 72 65 63 nclude "task_rec
0240: 6f 72 64 73 2e 73 63 6d 22 29 0a 0a 3b 3b 3d 3d ords.scm")..;;==
0250: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0260: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0270: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0280: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0290: 3d 3d 3d 3d 0a 3b 3b 20 54 61 73 6b 73 20 64 62 ====.;; Tasks db
02a0: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
02b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
02c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
02d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
02e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 =========..(defi
02f0: 6e 65 20 28 74 61 73 6b 73 3a 6f 70 65 6e 2d 64 ne (tasks:open-d
0300: 62 29 0a 20 20 28 6c 65 74 2a 20 28 28 64 62 70 b). (let* ((dbp
0310: 61 74 68 20 20 28 63 6f 6e 63 20 2a 74 6f 70 70 ath (conc *topp
0320: 61 74 68 2a 20 22 2f 6d 6f 6e 69 74 6f 72 2e 64 ath* "/monitor.d
0330: 62 22 29 29 0a 09 20 28 65 78 69 73 74 73 20 20 b")).. (exists
0340: 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 64 62 (file-exists? db
0350: 70 61 74 68 29 29 0a 09 20 3b 3b 20 09 20 20 20 path)).. ;; .
0360: 20 20 20 3b 3b 20 42 55 47 47 49 53 48 4e 45 53 ;; BUGGISHNES
0370: 53 3a 20 52 65 6d 6f 76 65 20 74 68 69 73 20 63 S: Remove this c
0380: 6f 64 65 20 69 6e 20 73 69 78 20 6d 6f 6e 74 68 ode in six month
0390: 73 2e 20 54 6f 64 61 79 20 69 73 20 31 31 2f 31 s. Today is 11/1
03a0: 33 2f 32 30 31 32 0a 09 20 3b 3b 20 20 20 20 20 3/2012.. ;;
03b0: 20 20 20 20 20 20 20 20 20 28 69 66 20 28 3c 20 (if (<
03c0: 28 66 69 6c 65 2d 63 68 61 6e 67 65 2d 74 69 6d (file-change-tim
03d0: 65 20 64 62 70 61 74 68 29 20 31 33 35 32 38 35 e dbpath) 135285
03e0: 31 33 39 36 2e 30 29 0a 09 20 3b 3b 20 20 20 20 1396.0).. ;;
03f0: 20 20 20 20 09 20 20 28 62 65 67 69 6e 0a 09 20 . (begin..
0400: 3b 3b 20 20 20 20 20 20 20 20 09 20 20 20 20 28 ;; . (
0410: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 4e debug:print 0 "N
0420: 4f 54 45 3a 20 72 65 6d 6f 76 69 6e 67 20 6f 6c OTE: removing ol
0430: 64 20 64 62 20 66 69 6c 65 20 22 20 64 62 70 61 d db file " dbpa
0440: 74 68 29 0a 09 20 3b 3b 20 20 20 20 20 20 20 20 th).. ;;
0450: 09 20 20 20 20 28 64 65 6c 65 74 65 2d 66 69 6c . (delete-fil
0460: 65 20 64 62 70 61 74 68 29 0a 09 20 3b 3b 20 20 e dbpath).. ;;
0470: 20 20 20 20 20 20 09 20 20 20 20 23 66 29 0a 09 . #f)..
0480: 20 3b 3b 20 20 20 20 20 20 20 20 09 20 20 23 74 ;; . #t
0490: 29 0a 09 20 3b 3b 20 20 20 20 20 20 20 20 20 20 ).. ;;
04a0: 20 20 20 20 23 66 29 29 0a 09 20 28 6d 64 62 20 #f)).. (mdb
04b0: 20 20 20 20 28 73 71 6c 69 74 65 33 3a 6f 70 65 (sqlite3:ope
04c0: 6e 2d 64 61 74 61 62 61 73 65 20 64 62 70 61 74 n-database dbpat
04d0: 68 29 29 20 3b 3b 20 28 6e 65 76 65 72 2d 67 69 h)) ;; (never-gi
04e0: 76 65 2d 75 70 2d 6f 70 65 6e 2d 64 62 20 64 62 ve-up-open-db db
04f0: 70 61 74 68 29 29 0a 09 20 28 68 61 6e 64 6c 65 path)).. (handle
0500: 72 20 28 6d 61 6b 65 2d 62 75 73 79 2d 74 69 6d r (make-busy-tim
0510: 65 6f 75 74 20 33 36 30 30 30 29 29 29 0a 20 20 eout 36000))).
0520: 20 20 28 73 71 6c 69 74 65 33 3a 73 65 74 2d 62 (sqlite3:set-b
0530: 75 73 79 2d 68 61 6e 64 6c 65 72 21 20 6d 64 62 usy-handler! mdb
0540: 20 68 61 6e 64 6c 65 72 29 0a 20 20 20 20 28 73 handler). (s
0550: 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 6d qlite3:execute m
0560: 64 62 20 28 63 6f 6e 63 20 22 50 52 41 47 4d 41 db (conc "PRAGMA
0570: 20 73 79 6e 63 68 72 6f 6e 6f 75 73 20 3d 20 30 synchronous = 0
0580: 3b 22 29 29 0a 20 20 20 20 28 69 66 20 28 6e 6f ;")). (if (no
0590: 74 20 65 78 69 73 74 73 29 0a 09 28 62 65 67 69 t exists)..(begi
05a0: 6e 0a 09 20 20 28 73 71 6c 69 74 65 33 3a 65 78 n.. (sqlite3:ex
05b0: 65 63 75 74 65 20 6d 64 62 20 22 43 52 45 41 54 ecute mdb "CREAT
05c0: 45 20 54 41 42 4c 45 20 49 46 20 4e 4f 54 20 45 E TABLE IF NOT E
05d0: 58 49 53 54 53 20 74 61 73 6b 73 5f 71 75 65 75 XISTS tasks_queu
05e0: 65 20 28 69 64 20 49 4e 54 45 47 45 52 20 50 52 e (id INTEGER PR
05f0: 49 4d 41 52 59 20 4b 45 59 2c 0a 20 20 20 20 20 IMARY KEY,.
0600: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0610: 20 20 20 20 20 20 20 20 20 20 20 61 63 74 69 6f actio
0620: 6e 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 n TEXT DEFAULT '
0630: 27 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ',.
0640: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0650: 20 20 20 6f 77 6e 65 72 20 54 45 58 54 2c 0a 20 owner TEXT,.
0660: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 s
0680: 74 61 74 65 20 54 45 58 54 20 44 45 46 41 55 4c tate TEXT DEFAUL
0690: 54 20 27 6e 65 77 27 2c 0a 20 20 20 20 20 20 20 T 'new',.
06a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
06b0: 20 20 20 20 20 20 20 20 20 74 61 72 67 65 74 20 target
06c0: 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 27 2c TEXT DEFAULT '',
06d0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
06e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
06f0: 20 6e 61 6d 65 20 54 45 58 54 20 44 45 46 41 55 name TEXT DEFAU
0700: 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 20 20 20 LT '',.
0710: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0720: 20 20 20 20 20 20 20 74 65 73 74 20 54 45 58 54 test TEXT
0730: 20 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 DEFAULT '',.
0740: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0750: 20 20 20 20 20 20 20 20 20 20 20 20 20 69 74 65 ite
0760: 6d 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 m TEXT DEFAULT '
0770: 27 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ',.
0780: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0790: 20 20 20 6b 65 79 6c 6f 63 6b 20 54 45 58 54 2c keylock TEXT,
07a0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
07b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
07c0: 20 70 61 72 61 6d 73 20 54 45 58 54 2c 0a 20 20 params TEXT,.
07d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
07e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 63 72 cr
07f0: 65 61 74 69 6f 6e 5f 74 69 6d 65 20 54 49 4d 45 eation_time TIME
0800: 53 54 41 4d 50 2c 0a 20 20 20 20 20 20 20 20 20 STAMP,.
0810: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0820: 20 20 20 20 20 20 20 65 78 65 63 75 74 69 6f 6e execution
0830: 5f 74 69 6d 65 20 54 49 4d 45 53 54 41 4d 50 29 _time TIMESTAMP)
0840: 3b 22 29 0a 09 20 20 28 73 71 6c 69 74 65 33 3a ;").. (sqlite3:
0850: 65 78 65 63 75 74 65 20 6d 64 62 20 22 43 52 45 execute mdb "CRE
0860: 41 54 45 20 54 41 42 4c 45 20 49 46 20 4e 4f 54 ATE TABLE IF NOT
0870: 20 45 58 49 53 54 53 20 6d 6f 6e 69 74 6f 72 73 EXISTS monitors
0880: 20 28 69 64 20 49 4e 54 45 47 45 52 20 50 52 49 (id INTEGER PRI
0890: 4d 41 52 59 20 4b 45 59 2c 0a 20 20 20 20 20 20 MARY KEY,.
08a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
08b0: 20 20 20 20 20 20 20 20 20 20 70 69 64 20 49 4e pid IN
08c0: 54 45 47 45 52 2c 0a 20 20 20 20 20 20 20 20 20 TEGER,.
08d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
08e0: 20 20 20 20 20 20 20 73 74 61 72 74 5f 74 69 6d start_tim
08f0: 65 20 54 49 4d 45 53 54 41 4d 50 2c 0a 20 20 20 e TIMESTAMP,.
0900: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0910: 20 20 20 20 20 20 20 20 20 20 20 20 20 6c 61 73 las
0920: 74 5f 75 70 64 61 74 65 20 54 49 4d 45 53 54 41 t_update TIMESTA
0930: 4d 50 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 MP,.
0940: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0950: 20 20 20 20 68 6f 73 74 6e 61 6d 65 20 54 45 58 hostname TEX
0960: 54 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 T,.
0970: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0980: 20 20 20 75 73 65 72 6e 61 6d 65 20 54 45 58 54 username TEXT
0990: 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ,.
09a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
09b0: 20 43 4f 4e 53 54 52 41 49 4e 54 20 6d 6f 6e 69 CONSTRAINT moni
09c0: 74 6f 72 73 5f 63 6f 6e 73 74 72 61 69 6e 74 20 tors_constraint
09d0: 55 4e 49 51 55 45 20 28 70 69 64 2c 68 6f 73 74 UNIQUE (pid,host
09e0: 6e 61 6d 65 29 29 3b 22 29 0a 09 20 20 28 73 71 name));").. (sq
09f0: 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 6d 64 lite3:execute md
0a00: 62 20 22 43 52 45 41 54 45 20 54 41 42 4c 45 20 b "CREATE TABLE
0a10: 49 46 20 4e 4f 54 20 45 58 49 53 54 53 20 73 65 IF NOT EXISTS se
0a20: 72 76 65 72 73 20 28 69 64 20 49 4e 54 45 47 45 rvers (id INTEGE
0a30: 52 20 50 52 49 4d 41 52 59 20 4b 45 59 2c 0a 20 R PRIMARY KEY,.
0a40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0a50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0a60: 20 70 69 64 20 49 4e 54 45 47 45 52 2c 0a 20 20 pid INTEGER,.
0a70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0a80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0a90: 69 6e 74 65 72 66 61 63 65 20 54 45 58 54 2c 0a interface TEXT,.
0aa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ab0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ac0: 20 20 68 6f 73 74 6e 61 6d 65 20 54 45 58 54 2c hostname TEXT,
0ad0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
0ae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0af0: 20 20 20 70 6f 72 74 20 49 4e 54 45 47 45 52 2c port INTEGER,
0b00: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
0b10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0b20: 20 20 20 73 74 61 72 74 5f 74 69 6d 65 20 54 49 start_time TI
0b30: 4d 45 53 54 41 4d 50 2c 0a 20 20 20 20 20 20 20 MESTAMP,.
0b40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0b50: 20 20 20 20 20 20 20 20 20 20 20 70 72 69 6f 72 prior
0b60: 69 74 79 20 49 4e 54 45 47 45 52 2c 0a 20 20 20 ity INTEGER,.
0b70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0b80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 s
0b90: 74 61 74 65 20 54 45 58 54 2c 0a 20 20 20 20 20 tate TEXT,.
0ba0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0bb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 6d 74 5f mt_
0bc0: 76 65 72 73 69 6f 6e 20 54 45 58 54 2c 0a 20 20 version TEXT,.
0bd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0be0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0bf0: 68 65 61 72 74 62 65 61 74 20 54 49 4d 45 53 54 heartbeat TIMEST
0c00: 41 4d 50 2c 0a 20 20 20 20 20 20 20 20 20 20 20 AMP,.
0c10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0c20: 20 20 20 20 43 4f 4e 53 54 52 41 49 4e 54 20 73 CONSTRAINT s
0c30: 65 72 76 65 72 73 5f 63 6f 6e 73 74 72 61 69 6e ervers_constrain
0c40: 74 20 55 4e 49 51 55 45 20 28 70 69 64 2c 68 6f t UNIQUE (pid,ho
0c50: 73 74 6e 61 6d 65 2c 70 6f 72 74 29 29 3b 22 29 stname,port));")
0c60: 0a 09 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 .. (sqlite3:exe
0c70: 63 75 74 65 20 6d 64 62 20 22 43 52 45 41 54 45 cute mdb "CREATE
0c80: 20 54 41 42 4c 45 20 49 46 20 4e 4f 54 20 45 58 TABLE IF NOT EX
0c90: 49 53 54 53 20 63 6c 69 65 6e 74 73 20 28 69 64 ISTS clients (id
0ca0: 20 49 4e 54 45 47 45 52 20 50 52 49 4d 41 52 59 INTEGER PRIMARY
0cb0: 20 4b 45 59 2c 0a 20 20 20 20 20 20 20 20 20 20 KEY,.
0cc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0cd0: 20 20 20 20 20 20 20 20 73 65 72 76 65 72 5f 69 server_i
0ce0: 64 20 49 4e 54 45 47 45 52 2c 0a 20 20 20 20 20 d INTEGER,.
0cf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d00: 20 20 20 20 20 20 20 20 20 20 20 20 20 70 69 64 pid
0d10: 20 49 4e 54 45 47 45 52 2c 0a 20 20 20 20 20 20 INTEGER,.
0d20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d30: 20 20 20 20 20 20 20 20 20 20 20 20 68 6f 73 74 host
0d40: 6e 61 6d 65 20 54 45 58 54 2c 0a 20 20 20 20 20 name TEXT,.
0d50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d60: 20 20 20 20 20 20 20 20 20 20 20 20 20 63 6d 64 cmd
0d70: 6c 69 6e 65 20 54 45 58 54 2c 0a 20 20 20 20 20 line TEXT,.
0d80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d90: 20 20 20 20 20 20 20 20 20 20 20 20 20 6c 6f 67 log
0da0: 69 6e 5f 74 69 6d 65 20 54 49 4d 45 53 54 41 4d in_time TIMESTAM
0db0: 50 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 P,.
0dc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0dd0: 20 20 20 20 20 6c 6f 67 6f 75 74 5f 74 69 6d 65 logout_time
0de0: 20 54 49 4d 45 53 54 41 4d 50 20 44 45 46 41 55 TIMESTAMP DEFAU
0df0: 4c 54 20 2d 31 2c 0a 20 20 20 20 20 20 20 20 20 LT -1,.
0e00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e10: 20 20 20 20 20 20 20 43 4f 4e 53 54 52 41 49 4e CONSTRAIN
0e20: 54 20 63 6c 69 65 6e 74 73 5f 63 6f 6e 73 74 72 T clients_constr
0e30: 61 69 6e 74 20 55 4e 49 51 55 45 20 28 70 69 64 aint UNIQUE (pid
0e40: 2c 68 6f 73 74 6e 61 6d 65 29 29 3b 22 29 0a 20 ,hostname));").
0e50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e70: 20 0a 09 20 20 29 29 0a 20 20 20 20 6d 64 62 29 .. )). mdb)
0e80: 29 0a 20 20 20 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d ). .;;=======
0e90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0ea0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0eb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0ec0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
0ed0: 3b 3b 20 53 65 72 76 65 72 20 61 6e 64 20 63 6c ;; Server and cl
0ee0: 69 65 6e 74 20 6d 61 6e 61 67 65 6d 65 6e 74 0a ient management.
0ef0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
0f00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0f10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0f20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0f30: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 73 74 61 ========..;; sta
0f40: 74 65 3a 20 27 6c 69 76 65 2c 20 27 73 68 75 74 te: 'live, 'shut
0f50: 74 69 6e 67 2d 64 6f 77 6e 2c 20 27 64 65 61 64 ting-down, 'dead
0f60: 0a 28 64 65 66 69 6e 65 20 28 74 61 73 6b 73 3a .(define (tasks:
0f70: 73 65 72 76 65 72 2d 72 65 67 69 73 74 65 72 20 server-register
0f80: 6d 64 62 20 70 69 64 20 69 6e 74 65 72 66 61 63 mdb pid interfac
0f90: 65 20 70 6f 72 74 20 70 72 69 6f 72 69 74 79 20 e port priority
0fa0: 73 74 61 74 65 29 0a 20 20 28 64 65 62 75 67 3a state). (debug:
0fb0: 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 74 print-info 11 "t
0fc0: 61 73 6b 73 3a 73 65 72 76 65 72 2d 72 65 67 69 asks:server-regi
0fd0: 73 74 65 72 20 22 20 70 69 64 20 22 20 22 20 69 ster " pid " " i
0fe0: 6e 74 65 72 66 61 63 65 20 22 20 22 20 70 6f 72 nterface " " por
0ff0: 74 20 22 20 22 20 70 72 69 6f 72 69 74 79 20 22 t " " priority "
1000: 20 22 20 73 74 61 74 65 29 0a 20 20 28 73 71 6c " state). (sql
1010: 69 74 65 33 3a 65 78 65 63 75 74 65 20 0a 20 20 ite3:execute .
1020: 20 6d 64 62 20 0a 20 20 20 22 49 4e 53 45 52 54 mdb . "INSERT
1030: 20 4f 52 20 52 45 50 4c 41 43 45 20 49 4e 54 4f OR REPLACE INTO
1040: 20 73 65 72 76 65 72 73 20 28 70 69 64 2c 68 6f servers (pid,ho
1050: 73 74 6e 61 6d 65 2c 70 6f 72 74 2c 73 74 61 72 stname,port,star
1060: 74 5f 74 69 6d 65 2c 70 72 69 6f 72 69 74 79 2c t_time,priority,
1070: 73 74 61 74 65 2c 6d 74 5f 76 65 72 73 69 6f 6e state,mt_version
1080: 2c 68 65 61 72 74 62 65 61 74 2c 69 6e 74 65 72 ,heartbeat,inter
1090: 66 61 63 65 29 0a 20 20 20 20 20 20 20 20 20 20 face).
10a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
10b0: 20 20 20 56 41 4c 55 45 53 28 3f 2c 20 20 3f 2c VALUES(?, ?,
10c0: 20 20 20 20 20 20 20 3f 2c 20 73 74 72 66 74 69 ?, strfti
10d0: 6d 65 28 27 25 73 27 2c 27 6e 6f 77 27 29 2c 20 me('%s','now'),
10e0: 3f 2c 20 3f 2c 20 3f 2c 20 73 74 72 66 74 69 6d ?, ?, ?, strftim
10f0: 65 28 27 25 73 27 2c 27 6e 6f 77 27 29 2c 3f 29 e('%s','now'),?)
1100: 3b 22 0a 20 20 20 70 69 64 20 28 67 65 74 2d 68 ;". pid (get-h
1110: 6f 73 74 2d 6e 61 6d 65 29 20 70 6f 72 74 20 70 ost-name) port p
1120: 72 69 6f 72 69 74 79 20 28 63 6f 6e 63 20 73 74 riority (conc st
1130: 61 74 65 29 20 6d 65 67 61 74 65 73 74 2d 76 65 ate) megatest-ve
1140: 72 73 69 6f 6e 20 69 6e 74 65 72 66 61 63 65 29 rsion interface)
1150: 0a 20 20 28 6c 69 73 74 20 0a 20 20 20 28 74 61 . (list . (ta
1160: 73 6b 73 3a 73 65 72 76 65 72 2d 67 65 74 2d 73 sks:server-get-s
1170: 65 72 76 65 72 2d 69 64 20 6d 64 62 20 28 67 65 erver-id mdb (ge
1180: 74 2d 68 6f 73 74 2d 6e 61 6d 65 29 20 69 6e 74 t-host-name) int
1190: 65 72 66 61 63 65 20 70 6f 72 74 20 70 69 64 29 erface port pid)
11a0: 0a 20 20 20 69 6e 74 65 72 66 61 63 65 0a 20 20 . interface.
11b0: 20 70 6f 72 74 0a 20 20 20 29 29 0a 0a 3b 3b 20 port. ))..;;
11c0: 4e 42 2f 2f 20 74 77 6f 20 73 65 72 76 65 72 73 NB// two servers
11d0: 20 77 69 74 68 20 73 61 6d 65 20 70 69 64 20 6f with same pid o
11e0: 6e 20 64 69 66 66 65 72 65 6e 74 20 68 6f 73 74 n different host
11f0: 73 20 77 69 6c 6c 20 62 65 20 72 65 6d 6f 76 65 s will be remove
1200: 64 20 66 72 6f 6d 20 74 68 65 20 6c 69 73 74 20 d from the list
1210: 69 66 20 70 69 64 3a 20 69 73 20 75 73 65 64 21 if pid: is used!
1220: 0a 28 64 65 66 69 6e 65 20 28 74 61 73 6b 73 3a .(define (tasks:
1230: 73 65 72 76 65 72 2d 64 65 72 65 67 69 73 74 65 server-deregiste
1240: 72 20 6d 64 62 20 68 6f 73 74 6e 61 6d 65 20 23 r mdb hostname #
1250: 21 6b 65 79 20 28 70 6f 72 74 20 23 66 29 28 70 !key (port #f)(p
1260: 69 64 20 23 66 29 28 61 63 74 69 6f 6e 20 27 6d id #f)(action 'm
1270: 61 72 6b 64 65 61 64 29 29 0a 20 20 28 64 65 62 arkdead)). (deb
1280: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 ug:print-info 11
1290: 20 22 73 65 72 76 65 72 2d 64 65 72 65 67 69 73 "server-deregis
12a0: 74 65 72 20 22 20 68 6f 73 74 6e 61 6d 65 20 22 ter " hostname "
12b0: 2c 20 70 6f 72 74 20 22 20 70 6f 72 74 20 22 2c , port " port ",
12c0: 20 70 69 64 20 22 20 70 69 64 29 0a 20 20 28 69 pid " pid). (i
12d0: 66 20 70 69 64 0a 20 20 20 20 20 20 28 63 61 73 f pid. (cas
12e0: 65 20 61 63 74 69 6f 6e 0a 09 28 28 64 65 6c 65 e action..((dele
12f0: 74 65 29 28 73 71 6c 69 74 65 33 3a 65 78 65 63 te)(sqlite3:exec
1300: 75 74 65 20 6d 64 62 20 22 44 45 4c 45 54 45 20 ute mdb "DELETE
1310: 46 52 4f 4d 20 73 65 72 76 65 72 73 20 57 48 45 FROM servers WHE
1320: 52 45 20 70 69 64 3d 3f 3b 22 20 70 69 64 29 29 RE pid=?;" pid))
1330: 0a 09 28 65 6c 73 65 20 20 20 20 28 73 71 6c 69 ..(else (sqli
1340: 74 65 33 3a 65 78 65 63 75 74 65 20 6d 64 62 20 te3:execute mdb
1350: 22 55 50 44 41 54 45 20 73 65 72 76 65 72 73 20 "UPDATE servers
1360: 53 45 54 20 73 74 61 74 65 3d 27 64 65 61 64 27 SET state='dead'
1370: 20 57 48 45 52 45 20 70 69 64 3d 3f 3b 22 20 70 WHERE pid=?;" p
1380: 69 64 29 29 29 0a 20 20 20 20 20 20 28 69 66 20 id))). (if
1390: 70 6f 72 74 0a 09 20 20 28 63 61 73 65 20 61 63 port.. (case ac
13a0: 74 69 6f 6e 0a 09 20 20 20 20 28 28 64 65 6c 65 tion.. ((dele
13b0: 74 65 29 28 73 71 6c 69 74 65 33 3a 65 78 65 63 te)(sqlite3:exec
13c0: 75 74 65 20 6d 64 62 20 22 44 45 4c 45 54 45 20 ute mdb "DELETE
13d0: 46 52 4f 4d 20 73 65 72 76 65 72 73 20 57 48 45 FROM servers WHE
13e0: 52 45 20 20 68 6f 73 74 6e 61 6d 65 3d 3f 20 41 RE hostname=? A
13f0: 4e 44 20 70 6f 72 74 3d 3f 3b 22 20 68 6f 73 74 ND port=?;" host
1400: 6e 61 6d 65 20 70 6f 72 74 29 29 0a 09 20 20 20 name port))..
1410: 20 28 65 6c 73 65 20 20 20 20 28 73 71 6c 69 74 (else (sqlit
1420: 65 33 3a 65 78 65 63 75 74 65 20 6d 64 62 20 22 e3:execute mdb "
1430: 55 50 44 41 54 45 20 73 65 72 76 65 72 73 20 53 UPDATE servers S
1440: 45 54 20 73 74 61 74 65 3d 27 64 65 61 64 27 20 ET state='dead'
1450: 57 48 45 52 45 20 68 6f 73 74 6e 61 6d 65 3d 3f WHERE hostname=?
1460: 20 41 4e 44 20 70 6f 72 74 3d 3f 3b 22 20 68 6f AND port=?;" ho
1470: 73 74 6e 61 6d 65 20 70 6f 72 74 29 29 29 0a 09 stname port)))..
1480: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
1490: 20 22 45 52 52 4f 52 3a 20 74 61 73 6b 73 3a 73 "ERROR: tasks:s
14a0: 65 72 76 65 72 2d 64 65 72 65 67 69 73 74 65 72 erver-deregister
14b0: 20 63 61 6c 6c 65 64 20 77 69 74 68 20 6e 65 69 called with nei
14c0: 74 68 65 72 20 70 69 64 20 6e 6f 72 20 70 6f 72 ther pid nor por
14d0: 74 20 73 70 65 63 69 66 69 65 64 22 29 29 29 29 t specified"))))
14e0: 0a 0a 28 64 65 66 69 6e 65 20 28 74 61 73 6b 73 ..(define (tasks
14f0: 3a 73 65 72 76 65 72 2d 64 65 72 65 67 69 73 74 :server-deregist
1500: 65 72 2d 73 65 6c 66 20 6d 64 62 20 68 6f 73 74 er-self mdb host
1510: 6e 61 6d 65 29 0a 20 20 28 74 61 73 6b 73 3a 73 name). (tasks:s
1520: 65 72 76 65 72 2d 64 65 72 65 67 69 73 74 65 72 erver-deregister
1530: 20 6d 64 62 20 68 6f 73 74 6e 61 6d 65 20 70 69 mdb hostname pi
1540: 64 3a 20 28 63 75 72 72 65 6e 74 2d 70 72 6f 63 d: (current-proc
1550: 65 73 73 2d 69 64 29 29 29 0a 0a 28 64 65 66 69 ess-id)))..(defi
1560: 6e 65 20 28 74 61 73 6b 73 3a 73 65 72 76 65 72 ne (tasks:server
1570: 2d 67 65 74 2d 73 65 72 76 65 72 2d 69 64 20 6d -get-server-id m
1580: 64 62 20 68 6f 73 74 6e 61 6d 65 20 69 66 61 63 db hostname ifac
1590: 65 20 70 6f 72 74 20 70 69 64 29 0a 20 20 28 6c e port pid). (l
15a0: 65 74 20 28 28 72 65 73 20 23 66 29 29 0a 20 20 et ((res #f)).
15b0: 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 (sqlite3:for-e
15c0: 61 63 68 2d 72 6f 77 0a 20 20 20 20 20 28 6c 61 ach-row. (la
15d0: 6d 62 64 61 20 28 69 64 29 0a 20 20 20 20 20 20 mbda (id).
15e0: 20 28 73 65 74 21 20 72 65 73 20 69 64 29 29 0a (set! res id)).
15f0: 20 20 20 20 20 6d 64 62 0a 20 20 20 20 20 28 63 mdb. (c
1600: 6f 6e 64 0a 20 20 20 20 20 20 28 28 61 6e 64 20 ond. ((and
1610: 68 6f 73 74 6e 61 6d 65 20 20 70 69 64 29 20 20 hostname pid)
1620: 22 53 45 4c 45 43 54 20 69 64 20 46 52 4f 4d 20 "SELECT id FROM
1630: 73 65 72 76 65 72 73 20 57 48 45 52 45 20 68 6f servers WHERE ho
1640: 73 74 6e 61 6d 65 3d 3f 20 20 41 4e 44 20 70 69 stname=? AND pi
1650: 64 3d 3f 3b 22 29 0a 20 20 20 20 20 20 28 28 61 d=?;"). ((a
1660: 6e 64 20 69 66 61 63 65 20 20 20 20 20 70 6f 72 nd iface por
1670: 74 29 20 22 53 45 4c 45 43 54 20 69 64 20 46 52 t) "SELECT id FR
1680: 4f 4d 20 73 65 72 76 65 72 73 20 57 48 45 52 45 OM servers WHERE
1690: 20 69 6e 74 65 72 66 61 63 65 3d 3f 20 41 4e 44 interface=? AND
16a0: 20 70 6f 72 74 3d 3f 3b 22 29 0a 20 20 20 20 20 port=?;").
16b0: 20 28 28 61 6e 64 20 68 6f 73 74 6e 61 6d 65 20 ((and hostname
16c0: 20 70 6f 72 74 29 20 22 53 45 4c 45 43 54 20 69 port) "SELECT i
16d0: 64 20 46 52 4f 4d 20 73 65 72 76 65 72 73 20 57 d FROM servers W
16e0: 48 45 52 45 20 68 6f 73 74 6e 61 6d 65 3d 3f 20 HERE hostname=?
16f0: 20 41 4e 44 20 70 6f 72 74 3d 3f 3b 22 29 0a 20 AND port=?;").
1700: 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 (else.
1710: 20 20 28 62 65 67 69 6e 0a 09 20 28 64 65 62 75 (begin.. (debu
1720: 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 g:print 0 "ERROR
1730: 3a 20 74 61 73 6b 73 3a 73 65 72 76 65 72 2d 67 : tasks:server-g
1740: 65 74 2d 73 65 72 76 65 72 2d 69 64 20 6e 65 65 et-server-id nee
1750: 64 73 20 28 68 6f 73 74 6e 61 6d 65 20 61 6e 64 ds (hostname and
1760: 20 70 69 64 29 20 4f 52 20 28 69 66 61 63 65 20 pid) OR (iface
1770: 61 6e 64 20 70 6f 72 74 29 20 4f 52 20 28 68 6f and port) OR (ho
1780: 73 74 6e 61 6d 65 20 61 6e 64 20 70 6f 72 74 29 stname and port)
1790: 22 29 0a 09 20 22 53 45 4c 45 43 54 20 69 64 20 ").. "SELECT id
17a0: 46 52 4f 4d 20 73 65 72 76 65 72 73 20 57 48 45 FROM servers WHE
17b0: 52 45 20 70 69 64 3d 2d 39 39 39 3b 22 29 29 29 RE pid=-999;")))
17c0: 0a 20 20 20 20 20 28 69 66 20 68 6f 73 74 6e 61 . (if hostna
17d0: 6d 65 20 68 6f 73 74 6e 61 6d 65 20 69 66 61 63 me hostname ifac
17e0: 65 29 28 69 66 20 70 69 64 20 70 69 64 20 70 6f e)(if pid pid po
17f0: 72 74 29 29 0a 20 20 20 20 72 65 73 29 29 0a 0a rt)). res))..
1800: 28 64 65 66 69 6e 65 20 28 74 61 73 6b 73 3a 73 (define (tasks:s
1810: 65 72 76 65 72 2d 75 70 64 61 74 65 2d 68 65 61 erver-update-hea
1820: 72 74 62 65 61 74 20 6d 64 62 20 73 65 72 76 65 rtbeat mdb serve
1830: 72 2d 69 64 29 0a 20 20 28 73 71 6c 69 74 65 33 r-id). (sqlite3
1840: 3a 65 78 65 63 75 74 65 20 6d 64 62 20 22 55 50 :execute mdb "UP
1850: 44 41 54 45 20 73 65 72 76 65 72 73 20 53 45 54 DATE servers SET
1860: 20 68 65 61 72 74 62 65 61 74 3d 73 74 72 66 74 heartbeat=strft
1870: 69 6d 65 28 27 25 73 27 2c 27 6e 6f 77 27 29 20 ime('%s','now')
1880: 57 48 45 52 45 20 69 64 3d 3f 3b 22 20 73 65 72 WHERE id=?;" ser
1890: 76 65 72 2d 69 64 29 29 0a 0a 3b 3b 20 61 6c 69 ver-id))..;; ali
18a0: 76 65 20 73 65 72 76 65 72 73 20 6b 65 65 70 20 ve servers keep
18b0: 74 68 65 20 68 65 61 72 74 62 65 61 74 20 66 69 the heartbeat fi
18c0: 65 6c 64 20 75 70 74 6f 20 64 61 74 65 20 77 69 eld upto date wi
18d0: 74 68 20 73 65 63 6f 6e 64 73 20 65 76 65 72 79 th seconds every
18e0: 20 36 20 6f 72 20 73 6f 20 73 65 63 6f 6e 64 73 6 or so seconds
18f0: 0a 28 64 65 66 69 6e 65 20 28 74 61 73 6b 73 3a .(define (tasks:
1900: 73 65 72 76 65 72 2d 61 6c 69 76 65 3f 20 6d 64 server-alive? md
1910: 62 20 73 65 72 76 65 72 2d 69 64 20 23 21 6b 65 b server-id #!ke
1920: 79 20 28 69 66 61 63 65 20 23 66 29 28 68 6f 73 y (iface #f)(hos
1930: 74 6e 61 6d 65 20 23 66 29 28 70 6f 72 74 20 23 tname #f)(port #
1940: 66 29 28 70 69 64 20 23 66 29 29 0a 20 20 28 6c f)(pid #f)). (l
1950: 65 74 2a 20 28 28 73 65 72 76 65 72 2d 69 64 20 et* ((server-id
1960: 20 28 69 66 20 73 65 72 76 65 72 2d 69 64 20 0a (if server-id .
1970: 09 09 09 20 73 65 72 76 65 72 2d 69 64 0a 09 09 ... server-id...
1980: 09 20 28 74 61 73 6b 73 3a 73 65 72 76 65 72 2d . (tasks:server-
1990: 67 65 74 2d 73 65 72 76 65 72 2d 69 64 20 6d 64 get-server-id md
19a0: 62 20 68 6f 73 74 6e 61 6d 65 20 69 66 61 63 65 b hostname iface
19b0: 20 70 6f 72 74 20 70 69 64 29 29 29 0a 09 20 28 port pid))).. (
19c0: 68 65 61 72 74 62 65 61 74 2d 64 65 6c 74 61 20 heartbeat-delta
19d0: 39 39 65 39 29 29 0a 20 20 20 20 28 73 71 6c 69 99e9)). (sqli
19e0: 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 te3:for-each-row
19f0: 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 64 . (lambda (d
1a00: 65 6c 74 61 29 0a 20 20 20 20 20 20 20 28 73 65 elta). (se
1a10: 74 21 20 68 65 61 72 74 62 65 61 74 2d 64 65 6c t! heartbeat-del
1a20: 74 61 20 64 65 6c 74 61 29 29 0a 20 20 20 20 20 ta delta)).
1a30: 6d 64 62 20 22 53 45 4c 45 43 54 20 73 74 72 66 mdb "SELECT strf
1a40: 74 69 6d 65 28 27 25 73 27 2c 27 6e 6f 77 27 29 time('%s','now')
1a50: 2d 68 65 61 72 74 62 65 61 74 20 46 52 4f 4d 20 -heartbeat FROM
1a60: 73 65 72 76 65 72 73 20 57 48 45 52 45 20 69 64 servers WHERE id
1a70: 3d 3f 3b 22 20 73 65 72 76 65 72 2d 69 64 29 0a =?;" server-id).
1a80: 20 20 20 20 28 3c 20 68 65 61 72 74 62 65 61 74 (< heartbeat
1a90: 2d 64 65 6c 74 61 20 31 30 29 29 29 0a 0a 28 64 -delta 10)))..(d
1aa0: 65 66 69 6e 65 20 28 74 61 73 6b 73 3a 63 6c 69 efine (tasks:cli
1ab0: 65 6e 74 2d 72 65 67 69 73 74 65 72 20 6d 64 62 ent-register mdb
1ac0: 20 70 69 64 20 68 6f 73 74 6e 61 6d 65 20 63 6d pid hostname cm
1ad0: 64 6c 69 6e 65 29 0a 20 20 28 73 71 6c 69 74 65 dline). (sqlite
1ae0: 33 3a 65 78 65 63 75 74 65 0a 20 20 20 6d 64 62 3:execute. mdb
1af0: 0a 20 20 20 22 49 4e 53 45 52 54 20 4f 52 20 52 . "INSERT OR R
1b00: 45 50 4c 41 43 45 20 49 4e 54 4f 20 63 6c 69 65 EPLACE INTO clie
1b10: 6e 74 73 20 28 73 65 72 76 65 72 5f 69 64 2c 70 nts (server_id,p
1b20: 69 64 2c 68 6f 73 74 6e 61 6d 65 2c 63 6d 64 6c id,hostname,cmdl
1b30: 69 6e 65 2c 6c 6f 67 69 6e 5f 74 69 6d 65 29 20 ine,login_time)
1b40: 56 41 4c 55 45 53 28 3f 2c 3f 2c 3f 2c 3f 2c 73 VALUES(?,?,?,?,s
1b50: 74 72 66 74 69 6d 65 28 27 25 73 27 2c 27 6e 6f trftime('%s','no
1b60: 77 27 29 29 3b 22 29 0a 20 20 28 74 61 73 6b 73 w'));"). (tasks
1b70: 3a 73 65 72 76 65 72 2d 67 65 74 2d 73 65 72 76 :server-get-serv
1b80: 65 72 2d 69 64 20 6d 64 62 20 68 6f 73 74 6e 61 er-id mdb hostna
1b90: 6d 65 20 23 66 20 23 66 20 70 69 64 29 0a 20 20 me #f #f pid).
1ba0: 70 69 64 20 68 6f 73 74 6e 61 6d 65 20 63 6d 64 pid hostname cmd
1bb0: 6c 69 6e 65 29 0a 0a 28 64 65 66 69 6e 65 20 28 line)..(define (
1bc0: 74 61 73 6b 73 3a 63 6c 69 65 6e 74 2d 6c 6f 67 tasks:client-log
1bd0: 6f 75 74 20 6d 64 62 20 70 69 64 20 68 6f 73 74 out mdb pid host
1be0: 6e 61 6d 65 20 63 6d 64 6c 69 6e 65 29 0a 20 20 name cmdline).
1bf0: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
1c00: 0a 20 20 20 6d 64 62 0a 20 20 20 22 55 50 44 41 . mdb. "UPDA
1c10: 54 45 20 63 6c 69 65 6e 74 73 20 53 45 54 20 6c TE clients SET l
1c20: 6f 67 6f 75 74 5f 74 69 6d 65 3d 73 74 72 66 74 ogout_time=strft
1c30: 69 6d 65 28 27 25 73 27 2c 27 6e 6f 77 27 29 20 ime('%s','now')
1c40: 57 48 45 52 45 20 70 69 64 3d 3f 20 41 4e 44 20 WHERE pid=? AND
1c50: 68 6f 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 63 hostname=? AND c
1c60: 6d 64 6c 69 6e 65 3d 3f 3b 22 0a 20 20 20 70 69 mdline=?;". pi
1c70: 64 20 68 6f 73 74 6e 61 6d 65 20 63 6d 64 6c 69 d hostname cmdli
1c80: 6e 65 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 ne))..(define (t
1c90: 61 73 6b 73 3a 67 65 74 2d 6c 6f 67 67 65 64 2d asks:get-logged-
1ca0: 69 6e 2d 63 6c 69 65 6e 74 73 20 6d 64 62 20 73 in-clients mdb s
1cb0: 65 72 76 65 72 2d 69 64 29 0a 20 20 28 6c 65 74 erver-id). (let
1cc0: 20 28 28 72 65 73 20 27 28 29 29 29 0a 20 20 20 ((res '())).
1cd0: 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 (sqlite3:for-ea
1ce0: 63 68 2d 72 6f 77 20 0a 20 20 20 20 20 28 6c 61 ch-row . (la
1cf0: 6d 62 64 61 20 28 69 64 20 73 65 72 76 65 72 2d mbda (id server-
1d00: 69 64 20 70 69 64 20 68 6f 73 74 6e 61 6d 65 20 id pid hostname
1d10: 63 6d 64 6c 69 6e 65 20 6c 6f 67 69 6e 2d 74 69 cmdline login-ti
1d20: 6d 65 20 6c 6f 67 6f 75 74 2d 74 69 6d 65 29 0a me logout-time).
1d30: 20 20 20 20 20 20 20 28 73 65 74 21 20 72 65 73 (set! res
1d40: 20 28 63 6f 6e 73 20 28 76 65 63 74 6f 72 20 69 (cons (vector i
1d50: 64 20 73 65 72 76 65 72 2d 69 64 20 70 69 64 20 d server-id pid
1d60: 68 6f 73 74 6e 61 6d 65 20 63 6d 64 6c 69 6e 65 hostname cmdline
1d70: 20 6c 6f 67 69 6e 2d 74 69 6d 65 20 6c 6f 75 67 login-time loug
1d80: 6f 75 74 2d 74 69 6d 65 29 20 72 65 73 29 29 29 out-time) res)))
1d90: 0a 20 20 20 20 20 6d 64 62 0a 20 20 20 20 20 22 . mdb. "
1da0: 53 45 4c 45 43 54 20 69 64 2c 73 65 72 76 65 72 SELECT id,server
1db0: 5f 69 64 2c 70 69 64 2c 68 6f 73 74 6e 61 6d 65 _id,pid,hostname
1dc0: 2c 63 6d 64 6c 69 6e 65 2c 6c 6f 67 69 6e 5f 74 ,cmdline,login_t
1dd0: 69 6d 65 2c 6c 6f 67 6f 75 74 5f 74 69 6d 65 20 ime,logout_time
1de0: 46 52 4f 4d 20 63 6c 69 65 6e 74 73 20 57 48 45 FROM clients WHE
1df0: 52 45 20 73 65 72 76 65 72 5f 69 64 3d 3f 3b 22 RE server_id=?;"
1e00: 0a 20 20 20 20 20 73 65 72 76 65 72 2d 69 64 29 . server-id)
1e10: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 61 73 ))..(define (tas
1e20: 6b 73 3a 68 61 76 65 2d 63 6c 69 65 6e 74 73 3f ks:have-clients?
1e30: 20 6d 64 62 20 73 65 72 76 65 72 2d 69 64 29 0a mdb server-id).
1e40: 20 20 28 6e 75 6c 6c 3f 20 28 74 61 73 6b 73 3a (null? (tasks:
1e50: 67 65 74 2d 6c 6f 67 67 65 64 2d 69 6e 2d 63 6c get-logged-in-cl
1e60: 69 65 6e 74 73 20 6d 64 62 20 73 65 72 76 65 72 ients mdb server
1e70: 2d 69 64 29 29 29 0a 0a 3b 3b 20 70 69 6e 67 20 -id)))..;; ping
1e80: 65 61 63 68 20 73 65 72 76 65 72 20 69 6e 20 74 each server in t
1e90: 68 65 20 64 62 20 61 6e 64 20 72 65 74 75 72 6e he db and return
1ea0: 20 66 69 72 73 74 20 66 6f 75 6e 64 20 74 68 61 first found tha
1eb0: 74 20 72 65 73 70 6f 6e 64 73 2e 20 0a 3b 3b 20 t responds. .;;
1ec0: 72 65 6d 6f 76 65 20 61 6e 79 20 6f 74 68 65 72 remove any other
1ed0: 73 2e 20 77 69 6c 6c 20 6e 6f 74 20 6e 65 63 65 s. will not nece
1ee0: 73 73 61 72 69 6c 79 20 72 65 6d 6f 76 65 20 61 ssarily remove a
1ef0: 6c 6c 21 0a 28 64 65 66 69 6e 65 20 28 74 61 73 ll!.(define (tas
1f00: 6b 73 3a 67 65 74 2d 62 65 73 74 2d 73 65 72 76 ks:get-best-serv
1f10: 65 72 20 6d 64 62 29 0a 20 20 28 6c 65 74 20 28 er mdb). (let (
1f20: 28 72 65 73 20 27 28 29 29 0a 09 28 62 65 73 74 (res '())..(best
1f30: 20 23 66 29 29 0a 20 20 20 20 28 73 71 6c 69 74 #f)). (sqlit
1f40: 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a e3:for-each-row.
1f50: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 69 64 (lambda (id
1f60: 20 68 6f 73 74 6e 61 6d 65 20 69 6e 74 65 72 66 hostname interf
1f70: 61 63 65 20 70 6f 72 74 20 70 69 64 29 0a 20 20 ace port pid).
1f80: 20 20 20 20 20 28 73 65 74 21 20 72 65 73 20 28 (set! res (
1f90: 63 6f 6e 73 20 28 6c 69 73 74 20 68 6f 73 74 6e cons (list hostn
1fa0: 61 6d 65 20 69 6e 74 65 72 66 61 63 65 20 70 6f ame interface po
1fb0: 72 74 20 70 69 64 20 69 64 29 20 72 65 73 29 29 rt pid id) res))
1fc0: 0a 20 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 . (debug:p
1fd0: 72 69 6e 74 2d 69 6e 66 6f 20 32 20 22 46 6f 75 rint-info 2 "Fou
1fe0: 6e 64 20 65 78 69 73 74 69 6e 67 20 73 65 72 76 nd existing serv
1ff0: 65 72 20 22 20 68 6f 73 74 6e 61 6d 65 20 22 3a er " hostname ":
2000: 22 20 70 6f 72 74 20 22 20 72 65 67 69 73 74 65 " port " registe
2010: 72 65 64 20 69 6e 20 64 62 22 29 29 0a 20 20 20 red in db")).
2020: 20 20 6d 64 62 0a 20 20 20 20 20 22 53 45 4c 45 mdb. "SELE
2030: 43 54 20 69 64 2c 68 6f 73 74 6e 61 6d 65 2c 69 CT id,hostname,i
2040: 6e 74 65 72 66 61 63 65 2c 70 6f 72 74 2c 70 69 nterface,port,pi
2050: 64 20 46 52 4f 4d 20 73 65 72 76 65 72 73 0a 20 d FROM servers.
2060: 20 20 20 20 20 20 20 20 57 48 45 52 45 20 73 74 WHERE st
2070: 72 66 74 69 6d 65 28 27 25 73 27 2c 27 6e 6f 77 rftime('%s','now
2080: 27 29 2d 68 65 61 72 74 62 65 61 74 20 3c 20 31 ')-heartbeat < 1
2090: 30 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0.
20a0: 20 41 4e 44 20 6d 74 5f 76 65 72 73 69 6f 6e 3d AND mt_version=
20b0: 3f 20 4f 52 44 45 52 20 42 59 20 73 74 61 72 74 ? ORDER BY start
20c0: 5f 74 69 6d 65 20 41 53 43 20 4c 49 4d 49 54 20 _time ASC LIMIT
20d0: 31 3b 22 20 6d 65 67 61 74 65 73 74 2d 76 65 72 1;" megatest-ver
20e0: 73 69 6f 6e 29 0a 20 20 20 20 3b 3b 20 66 6f 72 sion). ;; for
20f0: 20 6e 6f 77 20 77 65 20 61 72 65 20 6b 65 65 70 now we are keep
2100: 69 6e 67 20 6f 6e 6c 79 20 6f 6e 65 20 73 65 72 ing only one ser
2110: 76 65 72 20 72 65 67 69 73 74 65 72 65 64 20 69 ver registered i
2120: 6e 20 74 68 65 20 64 62 2c 20 72 65 74 75 72 6e n the db, return
2130: 20 23 66 20 6f 72 20 66 69 72 73 74 20 73 65 72 #f or first ser
2140: 76 65 72 20 66 6f 75 6e 64 0a 20 20 20 20 28 69 ver found. (i
2150: 66 20 28 6e 75 6c 6c 3f 20 72 65 73 29 20 23 66 f (null? res) #f
2160: 20 28 63 61 72 20 72 65 73 29 29 29 29 0a 0a 3b (car res))))..;
2170: 3b 20 42 55 47 3a 20 54 68 69 73 20 6c 6f 67 69 ; BUG: This logi
2180: 63 20 69 73 20 70 72 6f 62 61 62 6c 79 20 6e 65 c is probably ne
2190: 65 64 65 64 20 75 6e 6c 65 73 73 20 6d 65 74 68 eded unless meth
21a0: 6f 64 6f 6c 6f 67 79 20 63 68 61 6e 67 65 73 20 odology changes
21b0: 63 6f 6d 70 6c 65 74 65 6c 79 2e 2e 2e 0a 3b 3b completely....;;
21c0: 0a 3b 3b 20 20 20 20 20 28 69 66 20 28 6e 75 6c .;; (if (nul
21d0: 6c 3f 20 72 65 73 29 20 23 66 0a 3b 3b 20 09 28 l? res) #f.;; .(
21e0: 6c 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 20 28 let loop ((hed (
21f0: 63 61 72 20 72 65 73 29 29 0a 3b 3b 20 09 09 20 car res)).;; ..
2200: 20 20 28 74 61 6c 20 28 63 64 72 20 72 65 73 29 (tal (cdr res)
2210: 29 29 0a 3b 3b 20 09 20 20 3b 3b 20 28 70 72 69 )).;; . ;; (pri
2220: 6e 74 20 22 68 65 64 3d 22 20 68 65 64 20 22 2c nt "hed=" hed ",
2230: 20 74 61 6c 3d 22 20 74 61 6c 29 0a 3b 3b 20 09 tal=" tal).;; .
2240: 20 20 28 6c 65 74 2a 20 28 28 68 6f 73 74 20 20 (let* ((host
2250: 20 20 20 28 6c 69 73 74 2d 72 65 66 20 68 65 64 (list-ref hed
2260: 20 30 29 29 0a 3b 3b 20 09 09 20 28 69 66 61 63 0)).;; .. (ifac
2270: 65 20 20 20 20 28 6c 69 73 74 2d 72 65 66 20 68 e (list-ref h
2280: 65 64 20 31 29 29 0a 3b 3b 20 09 09 20 28 70 6f ed 1)).;; .. (po
2290: 72 74 20 20 20 20 20 28 6c 69 73 74 2d 72 65 66 rt (list-ref
22a0: 20 68 65 64 20 32 29 29 0a 3b 3b 20 09 09 20 28 hed 2)).;; .. (
22b0: 70 69 64 20 20 20 20 20 20 28 6c 69 73 74 2d 72 pid (list-r
22c0: 65 66 20 68 65 64 20 34 29 29 0a 3b 3b 20 09 09 ef hed 4)).;; ..
22d0: 20 28 61 6c 69 76 65 20 20 20 20 28 6f 70 65 6e (alive (open
22e0: 2d 72 75 6e 2d 63 6c 6f 73 65 20 74 61 73 6b 73 -run-close tasks
22f0: 3a 73 65 72 76 65 72 2d 61 6c 69 76 65 3f 20 74 :server-alive? t
2300: 61 73 6b 73 3a 6f 70 65 6e 2d 64 62 20 23 66 20 asks:open-db #f
2310: 68 6f 73 74 6e 61 6d 65 3a 20 68 6f 73 74 20 70 hostname: host p
2320: 6f 72 74 3a 20 70 6f 72 74 29 29 29 0a 3b 3b 20 ort: port))).;;
2330: 09 20 20 20 20 28 69 66 20 61 6c 69 76 65 0a 3b . (if alive.;
2340: 3b 20 09 09 28 62 65 67 69 6e 0a 3b 3b 20 09 09 ; ..(begin.;; ..
2350: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
2360: 6e 66 6f 20 32 20 22 46 6f 75 6e 64 20 61 6e 20 nfo 2 "Found an
2370: 65 78 69 73 74 69 6e 67 2c 20 61 6c 69 76 65 2c existing, alive,
2380: 20 73 65 72 76 65 72 20 22 20 68 6f 73 74 20 22 server " host "
2390: 2c 20 22 20 70 6f 72 74 20 22 2e 22 29 0a 3b 3b , " port ".").;;
23a0: 20 09 09 20 20 28 6c 69 73 74 20 68 6f 73 74 20 .. (list host
23b0: 69 66 61 63 65 20 70 6f 72 74 29 29 0a 3b 3b 20 iface port)).;;
23c0: 09 09 28 62 65 67 69 6e 0a 3b 3b 20 09 09 20 20 ..(begin.;; ..
23d0: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
23e0: 6f 20 31 20 22 4d 61 72 6b 69 6e 67 20 22 20 68 o 1 "Marking " h
23f0: 6f 73 74 20 22 3a 22 20 70 6f 72 74 20 22 20 61 ost ":" port " a
2400: 73 20 64 65 61 64 20 69 6e 20 73 65 72 76 65 72 s dead in server
2410: 20 72 65 67 69 73 74 72 79 2e 22 29 0a 3b 3b 20 registry.").;;
2420: 09 09 20 20 28 69 66 20 70 6f 72 74 0a 3b 3b 20 .. (if port.;;
2430: 09 09 20 20 20 20 20 20 28 6f 70 65 6e 2d 72 75 .. (open-ru
2440: 6e 2d 63 6c 6f 73 65 20 74 61 73 6b 73 3a 73 65 n-close tasks:se
2450: 72 76 65 72 2d 64 65 72 65 67 69 73 74 65 72 20 rver-deregister
2460: 74 61 73 6b 73 3a 6f 70 65 6e 2d 64 62 20 68 6f tasks:open-db ho
2470: 73 74 20 70 6f 72 74 3a 20 70 6f 72 74 29 0a 3b st port: port).;
2480: 3b 20 09 09 20 20 20 20 20 20 28 6f 70 65 6e 2d ; .. (open-
2490: 72 75 6e 2d 63 6c 6f 73 65 20 74 61 73 6b 73 3a run-close tasks:
24a0: 73 65 72 76 65 72 2d 64 65 72 65 67 69 73 74 65 server-deregiste
24b0: 72 20 74 61 73 6b 73 3a 6f 70 65 6e 2d 64 62 20 r tasks:open-db
24c0: 68 6f 73 74 20 70 69 64 3a 20 20 70 69 64 29 29 host pid: pid))
24d0: 0a 3b 3b 20 09 09 20 20 28 69 66 20 28 6e 75 6c .;; .. (if (nul
24e0: 6c 3f 20 74 61 6c 29 0a 3b 3b 20 09 09 20 20 20 l? tal).;; ..
24f0: 20 20 20 23 66 0a 3b 3b 20 09 09 20 20 20 20 20 #f.;; ..
2500: 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 (loop (car tal)
2510: 28 63 64 72 20 74 61 6c 29 29 29 29 29 29 29 29 (cdr tal))))))))
2520: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 61 73 ))..(define (tas
2530: 6b 73 3a 72 65 6d 6f 76 65 2d 73 65 72 76 65 72 ks:remove-server
2540: 2d 72 65 63 6f 72 64 73 20 6d 64 62 29 0a 20 20 -records mdb).
2550: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
2560: 20 6d 64 62 20 22 44 45 4c 45 54 45 20 46 52 4f mdb "DELETE FRO
2570: 4d 20 73 65 72 76 65 72 73 3b 22 29 29 0a 0a 28 M servers;"))..(
2580: 64 65 66 69 6e 65 20 28 74 61 73 6b 73 3a 6d 61 define (tasks:ma
2590: 72 6b 2d 73 65 72 76 65 72 20 68 6f 73 74 6e 61 rk-server hostna
25a0: 6d 65 20 70 6f 72 74 20 70 69 64 20 73 74 61 74 me port pid stat
25b0: 65 29 0a 20 20 28 69 66 20 70 6f 72 74 0a 20 20 e). (if port.
25c0: 20 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c (open-run-cl
25d0: 6f 73 65 20 74 61 73 6b 73 3a 73 65 72 76 65 72 ose tasks:server
25e0: 2d 64 65 72 65 67 69 73 74 65 72 20 74 61 73 6b -deregister task
25f0: 73 3a 6f 70 65 6e 2d 64 62 20 68 6f 73 74 6e 61 s:open-db hostna
2600: 6d 65 20 70 6f 72 74 3a 20 70 6f 72 74 29 0a 20 me port: port).
2610: 20 20 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 (open-run-c
2620: 6c 6f 73 65 20 74 61 73 6b 73 3a 73 65 72 76 65 lose tasks:serve
2630: 72 2d 64 65 72 65 67 69 73 74 65 72 20 74 61 73 r-deregister tas
2640: 6b 73 3a 6f 70 65 6e 2d 64 62 20 68 6f 73 74 6e ks:open-db hostn
2650: 61 6d 65 20 70 69 64 3a 20 20 70 69 64 29 29 29 ame pid: pid)))
2660: 0a 0a 0a 28 64 65 66 69 6e 65 20 28 74 61 73 6b ...(define (task
2670: 73 3a 6b 69 6c 6c 2d 73 65 72 76 65 72 20 73 74 s:kill-server st
2680: 61 74 75 73 20 68 6f 73 74 6e 61 6d 65 20 70 6f atus hostname po
2690: 72 74 20 70 69 64 29 0a 20 20 28 64 65 62 75 67 rt pid). (debug
26a0: 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 20 22 52 :print-info 1 "R
26b0: 65 6d 6f 76 69 6e 67 20 64 65 66 75 6e 63 74 20 emoving defunct
26c0: 73 65 72 76 65 72 20 72 65 63 6f 72 64 20 66 6f server record fo
26d0: 72 20 22 20 68 6f 73 74 6e 61 6d 65 20 22 3a 22 r " hostname ":"
26e0: 20 70 6f 72 74 29 0a 20 20 28 69 66 20 70 6f 72 port). (if por
26f0: 74 0a 20 20 20 20 20 20 28 6f 70 65 6e 2d 72 75 t. (open-ru
2700: 6e 2d 63 6c 6f 73 65 20 74 61 73 6b 73 3a 73 65 n-close tasks:se
2710: 72 76 65 72 2d 64 65 72 65 67 69 73 74 65 72 20 rver-deregister
2720: 74 61 73 6b 73 3a 6f 70 65 6e 2d 64 62 20 68 6f tasks:open-db ho
2730: 73 74 6e 61 6d 65 20 70 6f 72 74 3a 20 70 6f 72 stname port: por
2740: 74 29 0a 20 20 20 20 20 20 28 6f 70 65 6e 2d 72 t). (open-r
2750: 75 6e 2d 63 6c 6f 73 65 20 74 61 73 6b 73 3a 73 un-close tasks:s
2760: 65 72 76 65 72 2d 64 65 72 65 67 69 73 74 65 72 erver-deregister
2770: 20 74 61 73 6b 73 3a 6f 70 65 6e 2d 64 62 20 68 tasks:open-db h
2780: 6f 73 74 6e 61 6d 65 20 70 69 64 3a 20 20 70 69 ostname pid: pi
2790: 64 29 29 0a 20 20 28 69 66 20 73 74 61 74 75 73 d)). (if status
27a0: 20 3b 3b 20 23 74 20 6d 65 61 6e 73 20 61 6c 69 ;; #t means ali
27b0: 76 65 0a 20 20 20 20 20 20 28 62 65 67 69 6e 0a ve. (begin.
27c0: 09 28 69 66 20 28 65 71 75 61 6c 3f 20 68 6f 73 .(if (equal? hos
27d0: 74 6e 61 6d 65 20 28 67 65 74 2d 68 6f 73 74 2d tname (get-host-
27e0: 6e 61 6d 65 29 29 0a 09 20 20 20 20 28 68 61 6e name)).. (han
27f0: 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 dle-exceptions..
2800: 20 20 20 20 20 65 78 6e 0a 09 20 20 20 20 20 28 exn.. (
2810: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
2820: 20 30 20 22 73 65 72 76 65 72 20 6d 61 79 20 6f 0 "server may o
2830: 72 20 6d 61 79 20 6e 6f 74 20 62 65 20 64 65 61 r may not be dea
2840: 64 2c 20 63 68 65 63 6b 20 66 6f 72 20 6d 65 67 d, check for meg
2850: 61 74 65 73 74 20 2d 73 65 72 76 65 72 20 72 75 atest -server ru
2860: 6e 6e 69 6e 67 20 61 73 20 70 69 64 20 22 20 70 nning as pid " p
2870: 69 64 20 22 5c 6e 22 0a 09 09 09 20 20 20 20 20 id "\n"....
2880: 20 20 22 20 20 45 58 43 45 50 54 49 4f 4e 3a 20 " EXCEPTION:
2890: 22 20 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 " ((condition-pr
28a0: 6f 70 65 72 74 79 2d 61 63 63 65 73 73 6f 72 20 operty-accessor
28b0: 27 65 78 6e 20 27 6d 65 73 73 61 67 65 29 20 65 'exn 'message) e
28c0: 78 6e 29 29 0a 09 20 20 20 20 20 28 64 65 62 75 xn)).. (debu
28d0: 67 3a 70 72 69 6e 74 20 31 20 22 53 65 6e 64 69 g:print 1 "Sendi
28e0: 6e 67 20 73 69 67 6e 61 6c 2f 74 65 72 6d 20 74 ng signal/term t
28f0: 6f 20 22 20 70 69 64 20 22 20 6f 6e 20 22 20 68 o " pid " on " h
2900: 6f 73 74 6e 61 6d 65 29 0a 09 20 20 20 20 20 28 ostname).. (
2910: 70 72 6f 63 65 73 73 2d 73 69 67 6e 61 6c 20 70 process-signal p
2920: 69 64 20 73 69 67 6e 61 6c 2f 74 65 72 6d 29 0a id signal/term).
2930: 09 20 20 20 20 20 28 74 68 72 65 61 64 2d 73 6c . (thread-sl
2940: 65 65 70 21 20 35 29 20 3b 3b 20 67 69 76 65 20 eep! 5) ;; give
2950: 69 74 20 66 69 76 65 20 73 65 63 6f 6e 64 73 20 it five seconds
2960: 74 6f 20 64 69 65 20 70 65 61 63 65 66 75 6c 6c to die peacefull
2970: 79 20 74 68 65 6e 20 64 6f 20 61 20 62 72 75 74 y then do a brut
2980: 61 6c 20 6b 69 6c 6c 0a 09 20 20 20 20 20 28 70 al kill.. (p
2990: 72 6f 63 65 73 73 2d 73 69 67 6e 61 6c 20 70 69 rocess-signal pi
29a0: 64 20 73 69 67 6e 61 6c 2f 6b 69 6c 6c 29 29 20 d signal/kill))
29b0: 3b 3b 20 6c 6f 63 61 6c 20 6d 61 63 68 69 6e 65 ;; local machine
29c0: 2c 20 73 65 6e 64 20 73 69 67 20 74 65 72 6d 0a , send sig term.
29d0: 09 20 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 . (begin..
29e0: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
29f0: 69 6e 66 6f 20 31 20 22 54 65 6c 6c 69 6e 67 20 info 1 "Telling
2a00: 61 6c 69 76 65 20 73 65 72 76 65 72 20 6f 6e 20 alive server on
2a10: 22 20 68 6f 73 74 6e 61 6d 65 20 22 3a 22 20 70 " hostname ":" p
2a20: 6f 72 74 20 22 20 74 6f 20 63 6f 6d 6d 69 74 20 ort " to commit
2a30: 73 65 72 76 65 72 63 69 64 65 22 29 0a 09 20 20 servercide")..
2a40: 20 20 20 20 28 63 64 62 3a 6b 69 6c 6c 2d 73 65 (cdb:kill-se
2a50: 72 76 65 72 20 7a 6d 71 2d 73 6f 63 6b 65 74 29 rver zmq-socket)
2a60: 29 29 29 20 20 20 20 3b 3b 20 72 65 6d 6f 74 65 ))) ;; remote
2a70: 20 6d 61 63 68 69 6e 65 2c 20 74 72 79 20 74 65 machine, try te
2a80: 6c 6c 69 6e 67 20 73 65 72 76 65 72 20 74 6f 20 lling server to
2a90: 63 6f 6d 6d 69 74 20 73 75 69 63 69 64 65 0a 20 commit suicide.
2aa0: 20 20 20 20 20 28 62 65 67 69 6e 0a 09 28 69 66 (begin..(if
2ab0: 20 73 74 61 74 75 73 20 0a 09 20 20 20 20 28 69 status .. (i
2ac0: 66 20 28 65 71 75 61 6c 3f 20 68 6f 73 74 6e 61 f (equal? hostna
2ad0: 6d 65 20 28 67 65 74 2d 68 6f 73 74 2d 6e 61 6d me (get-host-nam
2ae0: 65 29 29 0a 09 09 28 62 65 67 69 6e 0a 09 09 20 e))...(begin...
2af0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
2b00: 66 6f 20 31 20 22 53 65 6e 64 69 6e 67 20 73 69 fo 1 "Sending si
2b10: 67 6e 61 6c 2f 74 65 72 6d 20 74 6f 20 22 20 70 gnal/term to " p
2b20: 69 64 20 22 20 6f 6e 20 22 20 68 6f 73 74 6e 61 id " on " hostna
2b30: 6d 65 29 0a 09 09 20 20 28 70 72 6f 63 65 73 73 me)... (process
2b40: 2d 73 69 67 6e 61 6c 20 70 69 64 20 73 69 67 6e -signal pid sign
2b50: 61 6c 2f 74 65 72 6d 29 20 20 3b 3b 20 6c 6f 63 al/term) ;; loc
2b60: 61 6c 20 6d 61 63 68 69 6e 65 2c 20 73 65 6e 64 al machine, send
2b70: 20 73 69 67 20 74 65 72 6d 0a 09 09 20 20 28 74 sig term... (t
2b80: 68 72 65 61 64 2d 73 6c 65 65 70 21 20 35 29 20 hread-sleep! 5)
2b90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2ba0: 3b 3b 20 67 69 76 65 20 69 74 20 66 69 76 65 20 ;; give it five
2bb0: 73 65 63 6f 6e 64 73 20 74 6f 20 64 69 65 20 70 seconds to die p
2bc0: 65 61 63 65 66 75 6c 6c 79 20 74 68 65 6e 20 64 eacefully then d
2bd0: 6f 20 61 20 62 72 75 74 61 6c 20 6b 69 6c 6c 0a o a brutal kill.
2be0: 09 09 20 20 28 70 72 6f 63 65 73 73 2d 73 69 67 .. (process-sig
2bf0: 6e 61 6c 20 70 69 64 20 73 69 67 6e 61 6c 2f 6b nal pid signal/k
2c00: 69 6c 6c 29 29 20 0a 09 09 28 64 65 62 75 67 3a ill)) ...(debug:
2c10: 70 72 69 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 print 0 "WARNING
2c20: 3a 20 43 61 6e 27 74 20 6b 69 6c 6c 20 66 72 6f : Can't kill fro
2c30: 7a 65 6e 20 73 65 72 76 65 72 20 6f 6e 20 72 65 zen server on re
2c40: 6d 6f 74 65 20 68 6f 73 74 20 22 20 68 6f 73 74 mote host " host
2c50: 6e 61 6d 65 29 29 29 29 29 29 0a 0a 0a 0a 28 64 name))))))....(d
2c60: 65 66 69 6e 65 20 28 74 61 73 6b 73 3a 67 65 74 efine (tasks:get
2c70: 2d 61 6c 6c 2d 73 65 72 76 65 72 73 20 6d 64 62 -all-servers mdb
2c80: 29 0a 20 20 28 6c 65 74 20 28 28 72 65 73 20 27 ). (let ((res '
2c90: 28 29 29 29 0a 20 20 20 20 28 73 71 6c 69 74 65 ())). (sqlite
2ca0: 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 20 3:for-each-row.
2cb0: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 69 64 20 (lambda (id
2cc0: 70 69 64 20 68 6f 73 74 6e 61 6d 65 20 69 6e 74 pid hostname int
2cd0: 65 72 66 61 63 65 20 70 6f 72 74 20 73 74 61 72 erface port star
2ce0: 74 2d 74 69 6d 65 20 70 72 69 6f 72 69 74 79 20 t-time priority
2cf0: 73 74 61 74 65 20 6d 74 2d 76 65 72 73 69 6f 6e state mt-version
2d00: 20 6c 61 73 74 2d 75 70 64 61 74 65 29 0a 20 20 last-update).
2d10: 20 20 20 20 20 28 73 65 74 21 20 72 65 73 20 28 (set! res (
2d20: 63 6f 6e 73 20 28 76 65 63 74 6f 72 20 69 64 20 cons (vector id
2d30: 70 69 64 20 68 6f 73 74 6e 61 6d 65 20 69 6e 74 pid hostname int
2d40: 65 72 66 61 63 65 20 70 6f 72 74 20 73 74 61 72 erface port star
2d50: 74 2d 74 69 6d 65 20 70 72 69 6f 72 69 74 79 20 t-time priority
2d60: 73 74 61 74 65 20 6d 74 2d 76 65 72 73 69 6f 6e state mt-version
2d70: 20 6c 61 73 74 2d 75 70 64 61 74 65 29 20 72 65 last-update) re
2d80: 73 29 29 29 0a 20 20 20 20 20 6d 64 62 0a 20 20 s))). mdb.
2d90: 20 20 20 22 53 45 4c 45 43 54 20 69 64 2c 70 69 "SELECT id,pi
2da0: 64 2c 68 6f 73 74 6e 61 6d 65 2c 69 6e 74 65 72 d,hostname,inter
2db0: 66 61 63 65 2c 70 6f 72 74 2c 73 74 61 72 74 5f face,port,start_
2dc0: 74 69 6d 65 2c 70 72 69 6f 72 69 74 79 2c 73 74 time,priority,st
2dd0: 61 74 65 2c 6d 74 5f 76 65 72 73 69 6f 6e 2c 73 ate,mt_version,s
2de0: 74 72 66 74 69 6d 65 28 27 25 73 27 2c 27 6e 6f trftime('%s','no
2df0: 77 27 29 2d 68 65 61 72 74 62 65 61 74 20 41 53 w')-heartbeat AS
2e00: 20 6c 61 73 74 5f 75 70 64 61 74 65 20 46 52 4f last_update FRO
2e10: 4d 20 73 65 72 76 65 72 73 20 4f 52 44 45 52 20 M servers ORDER
2e20: 42 59 20 73 74 61 72 74 5f 74 69 6d 65 20 44 45 BY start_time DE
2e30: 53 43 3b 22 29 0a 20 20 20 20 72 65 73 29 29 0a SC;"). res)).
2e40: 20 20 20 20 20 20 20 0a 0a 3b 3b 3d 3d 3d 3d 3d ..;;=====
2e50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2e60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2e70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2e80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2e90: 3d 0a 3b 3b 20 54 61 73 6b 73 20 61 6e 64 20 54 =.;; Tasks and T
2ea0: 61 73 6b 20 6d 6f 6e 69 74 6f 72 73 0a 3b 3b 3d ask monitors.;;=
2eb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2ec0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2ed0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2ee0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2ef0: 3d 3d 3d 3d 3d 0a 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d =====...;;======
2f00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2f10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2f20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2f30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2f40: 0a 3b 3b 20 54 61 73 6b 73 0a 3b 3b 3d 3d 3d 3d .;; Tasks.;;====
2f50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2f60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2f70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2f80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2f90: 3d 3d 0a 0a 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d ==....;;========
2fa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2fb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2fc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2fd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
2fe0: 3b 20 54 61 73 6b 20 4d 6f 6e 69 74 6f 72 73 0a ; Task Monitors.
2ff0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
3000: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3030: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e ========..(defin
3040: 65 20 28 74 61 73 6b 73 3a 72 65 67 69 73 74 65 e (tasks:registe
3050: 72 2d 6d 6f 6e 69 74 6f 72 20 64 62 20 6d 64 62 r-monitor db mdb
3060: 29 0a 20 20 28 6c 65 74 2a 20 28 28 70 69 64 20 ). (let* ((pid
3070: 28 63 75 72 72 65 6e 74 2d 70 72 6f 63 65 73 73 (current-process
3080: 2d 69 64 29 29 0a 09 20 28 68 6f 73 74 6e 61 6d -id)).. (hostnam
3090: 65 20 28 67 65 74 2d 68 6f 73 74 2d 6e 61 6d 65 e (get-host-name
30a0: 29 29 0a 09 20 28 75 73 65 72 69 6e 66 6f 20 28 )).. (userinfo (
30b0: 75 73 65 72 2d 69 6e 66 6f 72 6d 61 74 69 6f 6e user-information
30c0: 20 28 63 75 72 72 65 6e 74 2d 75 73 65 72 2d 69 (current-user-i
30d0: 64 29 29 29 0a 09 20 28 75 73 65 72 6e 61 6d 65 d))).. (username
30e0: 20 28 63 61 72 20 75 73 65 72 69 6e 66 6f 29 29 (car userinfo))
30f0: 29 0a 20 20 20 20 28 70 72 69 6e 74 20 22 52 65 ). (print "Re
3100: 67 69 73 74 65 72 20 6d 6f 6e 69 74 6f 72 2c 20 gister monitor,
3110: 70 69 64 3a 20 22 20 70 69 64 20 22 2c 20 68 6f pid: " pid ", ho
3120: 73 74 6e 61 6d 65 3a 20 22 20 68 6f 73 74 6e 61 stname: " hostna
3130: 6d 65 20 22 2c 20 75 73 65 72 6e 61 6d 65 3a 20 me ", username:
3140: 22 20 75 73 65 72 6e 61 6d 65 29 0a 20 20 20 20 " username).
3150: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
3160: 20 6d 64 62 20 22 49 4e 53 45 52 54 20 49 4e 54 mdb "INSERT INT
3170: 4f 20 6d 6f 6e 69 74 6f 72 73 20 28 70 69 64 2c O monitors (pid,
3180: 73 74 61 72 74 5f 74 69 6d 65 2c 6c 61 73 74 5f start_time,last_
3190: 75 70 64 61 74 65 2c 68 6f 73 74 6e 61 6d 65 2c update,hostname,
31a0: 75 73 65 72 6e 61 6d 65 29 20 56 41 4c 55 45 53 username) VALUES
31b0: 20 28 3f 2c 73 74 72 66 74 69 6d 65 28 27 25 73 (?,strftime('%s
31c0: 27 2c 27 6e 6f 77 27 29 2c 73 74 72 66 74 69 6d ','now'),strftim
31d0: 65 28 27 25 73 27 2c 27 6e 6f 77 27 29 2c 3f 2c e('%s','now'),?,
31e0: 3f 29 3b 22 0a 09 09 20 20 20 20 20 70 69 64 20 ?);"... pid
31f0: 68 6f 73 74 6e 61 6d 65 20 75 73 65 72 6e 61 6d hostname usernam
3200: 65 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 e)))..(define (t
3210: 61 73 6b 73 3a 67 65 74 2d 6e 75 6d 2d 61 6c 69 asks:get-num-ali
3220: 76 65 2d 6d 6f 6e 69 74 6f 72 73 20 6d 64 62 29 ve-monitors mdb)
3230: 0a 20 20 28 6c 65 74 20 28 28 72 65 73 20 30 29 . (let ((res 0)
3240: 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 ). (sqlite3:f
3250: 6f 72 2d 65 61 63 68 2d 72 6f 77 20 0a 20 20 20 or-each-row .
3260: 20 20 28 6c 61 6d 62 64 61 20 28 63 6f 75 6e 74 (lambda (count
3270: 29 0a 20 20 20 20 20 20 20 28 73 65 74 21 20 72 ). (set! r
3280: 65 73 20 63 6f 75 6e 74 29 29 0a 20 20 20 20 20 es count)).
3290: 6d 64 62 0a 20 20 20 20 20 22 53 45 4c 45 43 54 mdb. "SELECT
32a0: 20 63 6f 75 6e 74 28 69 64 29 20 46 52 4f 4d 20 count(id) FROM
32b0: 6d 6f 6e 69 74 6f 72 73 20 57 48 45 52 45 20 6c monitors WHERE l
32c0: 61 73 74 5f 75 70 64 61 74 65 20 3c 20 28 73 74 ast_update < (st
32d0: 72 66 74 69 6d 65 28 27 25 73 27 2c 27 6e 6f 77 rftime('%s','now
32e0: 27 29 20 2d 20 33 30 30 29 20 41 4e 44 20 75 73 ') - 300) AND us
32f0: 65 72 6e 61 6d 65 3d 3f 3b 22 0a 20 20 20 20 20 ername=?;".
3300: 28 63 61 72 20 28 75 73 65 72 2d 69 6e 66 6f 72 (car (user-infor
3310: 6d 61 74 69 6f 6e 20 28 63 75 72 72 65 6e 74 2d mation (current-
3320: 75 73 65 72 2d 69 64 29 29 29 29 0a 20 20 20 20 user-id)))).
3330: 72 65 73 29 29 0a 0a 3b 3b 20 72 65 67 69 73 74 res))..;; regist
3340: 65 72 20 61 20 74 61 73 6b 0a 28 64 65 66 69 6e er a task.(defin
3350: 65 20 28 74 61 73 6b 73 3a 61 64 64 20 6d 64 62 e (tasks:add mdb
3360: 20 61 63 74 69 6f 6e 20 6f 77 6e 65 72 20 74 61 action owner ta
3370: 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 74 65 73 rget runname tes
3380: 74 20 69 74 65 6d 20 70 61 72 61 6d 73 29 0a 20 t item params).
3390: 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 (sqlite3:execut
33a0: 65 20 6d 64 62 20 22 49 4e 53 45 52 54 20 49 4e e mdb "INSERT IN
33b0: 54 4f 20 74 61 73 6b 73 5f 71 75 65 75 65 20 28 TO tasks_queue (
33c0: 61 63 74 69 6f 6e 2c 6f 77 6e 65 72 2c 73 74 61 action,owner,sta
33d0: 74 65 2c 74 61 72 67 65 74 2c 6e 61 6d 65 2c 74 te,target,name,t
33e0: 65 73 74 2c 69 74 65 6d 2c 70 61 72 61 6d 73 2c est,item,params,
33f0: 63 72 65 61 74 69 6f 6e 5f 74 69 6d 65 2c 65 78 creation_time,ex
3400: 65 63 75 74 69 6f 6e 5f 74 69 6d 65 29 0a 20 20 ecution_time).
3410: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3420: 20 20 20 20 20 56 41 4c 55 45 53 20 28 3f 2c 3f VALUES (?,?
3430: 2c 27 6e 65 77 27 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f ,'new',?,?,?,?,?
3440: 2c 73 74 72 66 74 69 6d 65 28 27 25 73 27 2c 27 ,strftime('%s','
3450: 6e 6f 77 27 29 2c 30 29 3b 22 20 0a 09 09 20 20 now'),0);" ...
3460: 20 61 63 74 69 6f 6e 0a 09 09 20 20 20 6f 77 6e action... own
3470: 65 72 0a 09 09 20 20 20 74 61 72 67 65 74 0a 09 er... target..
3480: 09 20 20 20 72 75 6e 6e 61 6d 65 0a 09 09 20 20 . runname...
3490: 20 74 65 73 74 0a 09 09 20 20 20 69 74 65 6d 0a test... item.
34a0: 09 09 20 20 20 28 69 66 20 70 61 72 61 6d 73 20 .. (if params
34b0: 70 61 72 61 6d 73 20 22 22 29 29 29 0a 0a 28 64 params "")))..(d
34c0: 65 66 69 6e 65 20 28 6b 65 79 73 3a 6b 65 79 2d efine (keys:key-
34d0: 76 61 6c 73 2d 68 61 73 68 2d 3e 74 61 72 67 65 vals-hash->targe
34e0: 74 20 6b 65 79 73 20 6b 65 79 2d 70 61 72 61 6d t keys key-param
34f0: 73 29 0a 20 20 28 6c 65 74 20 28 28 74 6d 70 20 s). (let ((tmp
3500: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
3510: 64 65 66 61 75 6c 74 20 6b 65 79 2d 70 61 72 61 default key-para
3520: 6d 73 20 28 76 65 63 74 6f 72 2d 72 65 66 20 28 ms (vector-ref (
3530: 63 61 72 20 6b 65 79 73 29 20 30 29 20 22 22 29 car keys) 0) "")
3540: 29 29 0a 20 20 20 20 28 69 66 20 28 3e 20 28 6c )). (if (> (l
3550: 65 6e 67 74 68 20 6b 65 79 73 29 20 31 29 0a 09 ength keys) 1)..
3560: 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 (for-each (lambd
3570: 61 20 28 6b 65 79 29 0a 09 09 20 20 20 20 28 73 a (key)... (s
3580: 65 74 21 20 74 6d 70 20 28 63 6f 6e 63 20 74 6d et! tmp (conc tm
3590: 70 20 22 2f 22 20 28 68 61 73 68 2d 74 61 62 6c p "/" (hash-tabl
35a0: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 6b 65 e-ref/default ke
35b0: 79 2d 70 61 72 61 6d 73 20 28 76 65 63 74 6f 72 y-params (vector
35c0: 2d 72 65 66 20 6b 65 79 20 30 29 20 22 22 29 29 -ref key 0) ""))
35d0: 29 29 0a 09 09 20 20 28 63 64 72 20 6b 65 79 73 ))... (cdr keys
35e0: 29 29 29 0a 20 20 20 20 74 6d 70 29 29 0a 09 09 ))). tmp))...
35f0: 09 09 09 09 09 09 0a 3b 3b 20 66 6f 72 20 75 73 .......;; for us
3600: 65 20 66 72 6f 6d 20 74 68 65 20 67 75 69 0a 28 e from the gui.(
3610: 64 65 66 69 6e 65 20 28 74 61 73 6b 73 3a 61 64 define (tasks:ad
3620: 64 2d 66 72 6f 6d 2d 70 61 72 61 6d 73 20 6d 64 d-from-params md
3630: 62 20 61 63 74 69 6f 6e 20 6b 65 79 73 20 6b 65 b action keys ke
3640: 79 2d 70 61 72 61 6d 73 20 76 61 72 2d 70 61 72 y-params var-par
3650: 61 6d 73 29 0a 20 20 28 6c 65 74 20 28 28 74 61 ams). (let ((ta
3660: 72 67 65 74 20 20 20 20 28 6b 65 79 73 3a 6b 65 rget (keys:ke
3670: 79 2d 76 61 6c 73 2d 68 61 73 68 2d 3e 74 61 72 y-vals-hash->tar
3680: 67 65 74 20 6b 65 79 73 20 6b 65 79 2d 70 61 72 get keys key-par
3690: 61 6d 73 29 29 0a 09 28 6f 77 6e 65 72 20 20 20 ams))..(owner
36a0: 20 20 28 63 61 72 20 28 75 73 65 72 2d 69 6e 66 (car (user-inf
36b0: 6f 72 6d 61 74 69 6f 6e 20 28 63 75 72 72 65 6e ormation (curren
36c0: 74 2d 75 73 65 72 2d 69 64 29 29 29 29 0a 09 28 t-user-id))))..(
36d0: 72 75 6e 6e 61 6d 65 20 20 20 28 68 61 73 68 2d runname (hash-
36e0: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
36f0: 74 20 76 61 72 2d 70 61 72 61 6d 73 20 22 72 75 t var-params "ru
3700: 6e 6e 61 6d 65 22 20 23 66 29 29 0a 09 28 74 65 nname" #f))..(te
3710: 73 74 70 61 74 74 73 20 28 68 61 73 68 2d 74 61 stpatts (hash-ta
3720: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
3730: 76 61 72 2d 70 61 72 61 6d 73 20 22 74 65 73 74 var-params "test
3740: 70 61 74 74 73 22 20 22 25 22 29 29 0a 09 28 69 patts" "%"))..(i
3750: 74 65 6d 70 61 74 74 73 20 28 68 61 73 68 2d 74 tempatts (hash-t
3760: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
3770: 20 76 61 72 2d 70 61 72 61 6d 73 20 22 69 74 65 var-params "ite
3780: 6d 70 61 74 74 73 22 20 22 25 22 29 29 0a 09 28 mpatts" "%"))..(
3790: 70 61 72 61 6d 73 20 20 20 20 28 68 61 73 68 2d params (hash-
37a0: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
37b0: 74 20 76 61 72 2d 70 61 72 61 6d 73 20 22 70 61 t var-params "pa
37c0: 72 61 6d 73 22 20 20 20 20 22 22 29 29 29 0a 20 rams" ""))).
37d0: 20 20 20 28 74 61 73 6b 73 3a 61 64 64 20 6d 64 (tasks:add md
37e0: 62 20 61 63 74 69 6f 6e 20 6f 77 6e 65 72 20 74 b action owner t
37f0: 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 74 65 arget runname te
3800: 73 74 70 61 74 74 73 20 69 74 65 6d 70 61 74 74 stpatts itempatt
3810: 73 20 70 61 72 61 6d 73 29 29 29 0a 0a 3b 3b 20 s params)))..;;
3820: 72 65 74 75 72 6e 20 6f 6e 65 20 74 61 73 6b 20 return one task
3830: 66 72 6f 6d 20 74 68 6f 73 65 20 77 68 6f 20 61 from those who a
3840: 72 65 20 27 6e 65 77 27 20 4f 52 20 27 77 61 69 re 'new' OR 'wai
3850: 74 69 6e 67 27 20 41 4e 44 20 6d 6f 72 65 20 74 ting' AND more t
3860: 68 61 6e 20 31 30 73 65 63 20 6f 6c 64 0a 3b 3b han 10sec old.;;
3870: 0a 28 64 65 66 69 6e 65 20 28 74 61 73 6b 73 3a .(define (tasks:
3880: 73 6e 61 67 2d 61 2d 74 61 73 6b 20 6d 64 62 29 snag-a-task mdb)
3890: 0a 20 20 28 6c 65 74 20 28 28 72 65 73 20 20 20 . (let ((res
38a0: 20 23 66 29 0a 09 28 6b 65 79 74 78 74 20 28 63 #f)..(keytxt (c
38b0: 6f 6e 63 20 28 63 75 72 72 65 6e 74 2d 70 72 6f onc (current-pro
38c0: 63 65 73 73 2d 69 64 29 20 22 2d 22 20 28 67 65 cess-id) "-" (ge
38d0: 74 2d 68 6f 73 74 2d 6e 61 6d 65 29 20 22 2d 22 t-host-name) "-"
38e0: 20 28 63 61 72 20 28 75 73 65 72 2d 69 6e 66 6f (car (user-info
38f0: 72 6d 61 74 69 6f 6e 20 28 63 75 72 72 65 6e 74 rmation (current
3900: 2d 75 73 65 72 2d 69 64 29 29 29 29 29 29 0a 0a -user-id))))))..
3910: 20 20 20 20 3b 3b 20 66 69 72 73 74 20 72 61 6e ;; first ran
3920: 64 6f 6d 6c 79 20 73 65 74 20 61 20 6e 65 77 20 domly set a new
3930: 74 6f 20 70 69 64 2d 68 6f 73 74 6e 61 6d 65 2d to pid-hostname-
3940: 68 6f 73 74 6e 61 6d 65 0a 20 20 20 20 28 73 71 hostname. (sq
3950: 6c 69 74 65 33 3a 65 78 65 63 75 74 65 0a 20 20 lite3:execute.
3960: 20 20 20 6d 64 62 20 0a 20 20 20 20 20 22 55 50 mdb . "UP
3970: 44 41 54 45 20 74 61 73 6b 73 5f 71 75 65 75 65 DATE tasks_queue
3980: 20 53 45 54 20 6b 65 79 6c 6f 63 6b 3d 3f 20 57 SET keylock=? W
3990: 48 45 52 45 20 69 64 20 49 4e 0a 20 20 20 20 20 HERE id IN.
39a0: 20 20 20 28 53 45 4c 45 43 54 20 69 64 20 46 52 (SELECT id FR
39b0: 4f 4d 20 74 61 73 6b 73 5f 71 75 65 75 65 20 0a OM tasks_queue .
39c0: 20 20 20 20 20 20 20 20 20 20 20 57 48 45 52 45 WHERE
39d0: 20 73 74 61 74 65 3d 27 6e 65 77 27 20 4f 52 20 state='new' OR
39e0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
39f0: 20 20 28 73 74 61 74 65 3d 27 77 61 69 74 69 6e (state='waitin
3a00: 67 27 20 41 4e 44 20 28 73 74 72 66 74 69 6d 65 g' AND (strftime
3a10: 28 27 25 73 27 2c 27 6e 6f 77 27 29 2d 65 78 65 ('%s','now')-exe
3a20: 63 75 74 69 6f 6e 5f 74 69 6d 65 29 20 3e 20 31 cution_time) > 1
3a30: 30 29 20 4f 52 0a 20 20 20 20 20 20 20 20 20 20 0) OR.
3a40: 20 20 20 20 20 20 20 73 74 61 74 65 3d 27 72 65 state='re
3a50: 73 65 74 27 0a 20 20 20 20 20 20 20 20 20 20 20 set'.
3a60: 4f 52 44 45 52 20 42 59 20 52 41 4e 44 4f 4d 28 ORDER BY RANDOM(
3a70: 29 20 4c 49 4d 49 54 20 31 29 3b 22 20 6b 65 79 ) LIMIT 1);" key
3a80: 74 78 74 29 0a 0a 20 20 20 20 28 73 71 6c 69 74 txt).. (sqlit
3a90: 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a e3:for-each-row.
3aa0: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 69 64 (lambda (id
3ab0: 20 2e 20 72 65 6d 29 0a 20 20 20 20 20 20 20 28 . rem). (
3ac0: 73 65 74 21 20 72 65 73 20 28 61 70 70 6c 79 20 set! res (apply
3ad0: 76 65 63 74 6f 72 20 69 64 20 72 65 6d 29 29 29 vector id rem)))
3ae0: 0a 20 20 20 20 20 6d 64 62 0a 20 20 20 20 20 22 . mdb. "
3af0: 53 45 4c 45 43 54 20 69 64 2c 61 63 74 69 6f 6e SELECT id,action
3b00: 2c 6f 77 6e 65 72 2c 73 74 61 74 65 2c 74 61 72 ,owner,state,tar
3b10: 67 65 74 2c 6e 61 6d 65 2c 74 65 73 74 2c 69 74 get,name,test,it
3b20: 65 6d 2c 70 61 72 61 6d 73 2c 63 72 65 61 74 69 em,params,creati
3b30: 6f 6e 5f 74 69 6d 65 2c 65 78 65 63 75 74 69 6f on_time,executio
3b40: 6e 5f 74 69 6d 65 20 46 52 4f 4d 20 74 61 73 6b n_time FROM task
3b50: 73 5f 71 75 65 75 65 20 57 48 45 52 45 20 6b 65 s_queue WHERE ke
3b60: 79 6c 6f 63 6b 3d 3f 20 4f 52 44 45 52 20 42 59 ylock=? ORDER BY
3b70: 20 65 78 65 63 75 74 69 6f 6e 5f 74 69 6d 65 20 execution_time
3b80: 41 53 43 20 4c 49 4d 49 54 20 31 3b 22 20 6b 65 ASC LIMIT 1;" ke
3b90: 79 74 78 74 29 0a 20 20 20 20 28 69 66 20 72 65 ytxt). (if re
3ba0: 73 20 3b 3b 20 79 65 70 2c 20 68 61 76 65 20 77 s ;; yep, have w
3bb0: 6f 72 6b 20 74 6f 20 62 65 20 64 6f 6e 65 0a 09 ork to be done..
3bc0: 28 62 65 67 69 6e 0a 09 20 20 28 73 71 6c 69 74 (begin.. (sqlit
3bd0: 65 33 3a 65 78 65 63 75 74 65 20 6d 64 62 20 22 e3:execute mdb "
3be0: 55 50 44 41 54 45 20 74 61 73 6b 73 5f 71 75 65 UPDATE tasks_que
3bf0: 75 65 20 53 45 54 20 73 74 61 74 65 3d 27 69 6e ue SET state='in
3c00: 70 72 6f 67 72 65 73 73 27 2c 65 78 65 63 75 74 progress',execut
3c10: 69 6f 6e 5f 74 69 6d 65 3d 73 74 72 66 74 69 6d ion_time=strftim
3c20: 65 28 27 25 73 27 2c 27 6e 6f 77 27 29 20 57 48 e('%s','now') WH
3c30: 45 52 45 20 69 64 3d 3f 3b 22 0a 09 09 09 20 20 ERE id=?;"....
3c40: 20 28 74 61 73 6b 73 3a 74 61 73 6b 2d 67 65 74 (tasks:task-get
3c50: 2d 69 64 20 72 65 73 29 29 0a 09 20 20 72 65 73 -id res)).. res
3c60: 29 0a 09 23 66 29 29 29 0a 0a 28 64 65 66 69 6e )..#f)))..(defin
3c70: 65 20 28 74 61 73 6b 73 3a 72 65 73 65 74 2d 73 e (tasks:reset-s
3c80: 74 75 63 6b 2d 74 61 73 6b 73 20 6d 64 62 29 0a tuck-tasks mdb).
3c90: 20 20 28 6c 65 74 20 28 28 72 65 73 20 27 28 29 (let ((res '()
3ca0: 29 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a )). (sqlite3:
3cb0: 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 20 20 20 for-each-row.
3cc0: 20 20 28 6c 61 6d 62 64 61 20 28 69 64 20 64 65 (lambda (id de
3cd0: 6c 74 61 29 0a 20 20 20 20 20 20 20 28 73 65 74 lta). (set
3ce0: 21 20 72 65 73 20 28 63 6f 6e 73 20 69 64 20 72 ! res (cons id r
3cf0: 65 73 29 29 29 0a 20 20 20 20 20 6d 64 62 0a 20 es))). mdb.
3d00: 20 20 20 20 22 53 45 4c 45 43 54 20 69 64 2c 73 "SELECT id,s
3d10: 74 72 66 74 69 6d 65 28 27 25 73 27 2c 27 6e 6f trftime('%s','no
3d20: 77 27 29 2d 65 78 65 63 75 74 69 6f 6e 5f 74 69 w')-execution_ti
3d30: 6d 65 20 41 53 20 64 65 6c 74 61 20 46 52 4f 4d me AS delta FROM
3d40: 20 74 61 73 6b 73 5f 71 75 65 75 65 20 57 48 45 tasks_queue WHE
3d50: 52 45 20 73 74 61 74 65 3d 27 69 6e 70 72 6f 67 RE state='inprog
3d60: 72 65 73 73 27 20 41 4e 44 20 64 65 6c 74 61 3e ress' AND delta>
3d70: 37 30 30 20 4f 52 44 45 52 20 42 59 20 64 65 6c 700 ORDER BY del
3d80: 74 61 20 44 45 53 43 20 4c 49 4d 49 54 20 32 3b ta DESC LIMIT 2;
3d90: 22 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a "). (sqlite3:
3da0: 65 78 65 63 75 74 65 20 0a 20 20 20 20 20 6d 64 execute . md
3db0: 62 20 0a 20 20 20 20 20 28 63 6f 6e 63 20 22 55 b . (conc "U
3dc0: 50 44 41 54 45 20 74 61 73 6b 73 5f 71 75 65 75 PDATE tasks_queu
3dd0: 65 20 53 45 54 20 73 74 61 74 65 3d 27 72 65 73 e SET state='res
3de0: 65 74 27 20 57 48 45 52 45 20 69 64 20 49 4e 20 et' WHERE id IN
3df0: 28 27 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 ('" (string-inte
3e00: 72 73 70 65 72 73 65 20 28 6d 61 70 20 63 6f 6e rsperse (map con
3e10: 63 20 72 65 73 29 20 22 27 2c 27 22 29 20 22 27 c res) "','") "'
3e20: 29 3b 22 29 29 29 29 0a 0a 3b 3b 20 72 65 74 75 );"))))..;; retu
3e30: 72 6e 20 61 6c 6c 20 74 61 73 6b 73 20 69 6e 20 rn all tasks in
3e40: 74 68 65 20 74 61 73 6b 73 5f 71 75 65 75 65 20 the tasks_queue
3e50: 74 61 62 6c 65 0a 3b 3b 0a 28 64 65 66 69 6e 65 table.;;.(define
3e60: 20 28 74 61 73 6b 73 3a 67 65 74 2d 74 61 73 6b (tasks:get-task
3e70: 73 20 6d 64 62 20 74 79 70 65 73 20 73 74 61 74 s mdb types stat
3e80: 65 73 29 0a 20 20 28 6c 65 74 20 28 28 72 65 73 es). (let ((res
3e90: 20 27 28 29 29 29 0a 20 20 20 20 28 73 71 6c 69 '())). (sqli
3ea0: 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 te3:for-each-row
3eb0: 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 69 . (lambda (i
3ec0: 64 20 2e 20 72 65 6d 29 0a 20 20 20 20 20 20 20 d . rem).
3ed0: 28 73 65 74 21 20 72 65 73 20 28 63 6f 6e 73 20 (set! res (cons
3ee0: 28 61 70 70 6c 79 20 76 65 63 74 6f 72 20 69 64 (apply vector id
3ef0: 20 72 65 6d 29 20 72 65 73 29 29 29 0a 20 20 20 rem) res))).
3f00: 20 20 6d 64 62 0a 20 20 20 20 20 28 63 6f 6e 63 mdb. (conc
3f10: 20 22 53 45 4c 45 43 54 20 69 64 2c 61 63 74 69 "SELECT id,acti
3f20: 6f 6e 2c 6f 77 6e 65 72 2c 73 74 61 74 65 2c 74 on,owner,state,t
3f30: 61 72 67 65 74 2c 6e 61 6d 65 2c 74 65 73 74 2c arget,name,test,
3f40: 69 74 65 6d 2c 70 61 72 61 6d 73 2c 63 72 65 61 item,params,crea
3f50: 74 69 6f 6e 5f 74 69 6d 65 2c 65 78 65 63 75 74 tion_time,execut
3f60: 69 6f 6e 5f 74 69 6d 65 20 0a 20 20 20 20 20 20 ion_time .
3f70: 20 20 20 20 20 20 20 20 20 46 52 4f 4d 20 74 61 FROM ta
3f80: 73 6b 73 5f 71 75 65 75 65 20 22 0a 20 20 20 20 sks_queue ".
3f90: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 57 48 ;; WH
3fa0: 45 52 45 20 20 0a 20 20 20 20 20 20 20 20 20 20 ERE .
3fb0: 20 20 20 20 20 3b 3b 20 20 20 73 74 61 74 65 20 ;; state
3fc0: 49 4e 20 22 20 73 74 61 74 65 73 73 74 72 20 22 IN " statesstr "
3fd0: 20 41 4e 44 20 0a 09 20 20 20 20 20 20 20 3b 3b AND .. ;;
3fe0: 20 20 20 61 63 74 69 6f 6e 20 49 4e 20 22 20 61 action IN " a
3ff0: 63 74 69 6f 6e 73 73 74 72 20 0a 09 20 20 20 22 ctionsstr .. "
4000: 20 4f 52 44 45 52 20 42 59 20 63 72 65 61 74 69 ORDER BY creati
4010: 6f 6e 5f 74 69 6d 65 20 44 45 53 43 3b 22 29 29 on_time DESC;"))
4020: 0a 20 20 20 20 72 65 73 29 29 0a 0a 3b 3b 20 72 . res))..;; r
4030: 65 6d 6f 76 65 20 74 61 73 6b 73 20 67 69 76 65 emove tasks give
4040: 6e 20 62 79 20 61 20 73 74 72 69 6e 67 20 6f 66 n by a string of
4050: 20 6e 75 6d 62 65 72 73 20 63 6f 6d 6d 61 20 73 numbers comma s
4060: 65 70 61 72 61 74 65 64 0a 28 64 65 66 69 6e 65 eparated.(define
4070: 20 28 74 61 73 6b 73 3a 72 65 6d 6f 76 65 2d 71 (tasks:remove-q
4080: 75 65 75 65 2d 65 6e 74 72 69 65 73 20 6d 64 62 ueue-entries mdb
4090: 20 74 61 73 6b 2d 69 64 73 29 0a 20 20 28 73 71 task-ids). (sq
40a0: 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 6d 64 lite3:execute md
40b0: 62 20 28 63 6f 6e 63 20 22 44 45 4c 45 54 45 20 b (conc "DELETE
40c0: 46 52 4f 4d 20 74 61 73 6b 73 5f 71 75 65 75 65 FROM tasks_queue
40d0: 20 57 48 45 52 45 20 69 64 20 49 4e 20 28 22 20 WHERE id IN ("
40e0: 74 61 73 6b 2d 69 64 73 20 22 29 3b 22 29 29 29 task-ids ");")))
40f0: 0a 0a 3b 3b 20 0a 28 64 65 66 69 6e 65 20 28 74 ..;; .(define (t
4100: 61 73 6b 73 3a 73 74 61 72 74 2d 6d 6f 6e 69 74 asks:start-monit
4110: 6f 72 20 64 62 20 6d 64 62 29 0a 20 20 28 69 66 or db mdb). (if
4120: 20 28 3e 20 28 74 61 73 6b 73 3a 67 65 74 2d 6e (> (tasks:get-n
4130: 75 6d 2d 61 6c 69 76 65 2d 6d 6f 6e 69 74 6f 72 um-alive-monitor
4140: 73 20 6d 64 62 29 20 32 29 20 3b 3b 20 68 61 76 s mdb) 2) ;; hav
4150: 65 20 74 77 6f 20 72 75 6e 6e 69 6e 67 2c 20 6e e two running, n
4160: 6f 20 6e 65 65 64 20 66 6f 72 20 6d 6f 72 65 0a o need for more.
4170: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
4180: 6e 74 2d 69 6e 66 6f 20 31 20 22 4e 6f 74 20 73 nt-info 1 "Not s
4190: 74 61 72 74 69 6e 67 20 6d 6f 6e 69 74 6f 72 2c tarting monitor,
41a0: 20 61 6c 72 65 61 64 79 20 68 61 76 65 20 6d 6f already have mo
41b0: 72 65 20 74 68 61 6e 20 74 77 6f 20 72 75 6e 6e re than two runn
41c0: 69 6e 67 22 29 0a 20 20 20 20 20 20 28 6c 65 74 ing"). (let
41d0: 2a 20 28 28 6d 65 67 61 74 65 73 74 64 62 20 20 * ((megatestdb
41e0: 20 20 20 28 63 6f 6e 63 20 2a 74 6f 70 70 61 74 (conc *toppat
41f0: 68 2a 20 22 2f 6d 65 67 61 74 65 73 74 2e 64 62 h* "/megatest.db
4200: 22 29 29 0a 09 20 20 20 20 20 28 6d 6f 6e 69 74 ")).. (monit
4210: 6f 72 64 62 66 20 20 20 20 20 28 63 6f 6e 63 20 ordbf (conc
4220: 2a 74 6f 70 70 61 74 68 2a 20 22 2f 6d 6f 6e 69 *toppath* "/moni
4230: 74 6f 72 2e 64 62 22 29 29 0a 09 20 20 20 20 20 tor.db"))..
4240: 28 6c 61 73 74 2d 64 62 2d 75 70 64 61 74 65 20 (last-db-update
4250: 30 29 29 20 3b 3b 20 28 66 69 6c 65 2d 6d 6f 64 0)) ;; (file-mod
4260: 69 66 69 63 61 74 69 6f 6e 2d 74 69 6d 65 20 6d ification-time m
4270: 65 67 61 74 65 73 74 64 62 29 29 29 0a 09 28 74 egatestdb)))..(t
4280: 61 73 6b 3a 72 65 67 69 73 74 65 72 2d 6d 6f 6e ask:register-mon
4290: 69 74 6f 72 20 6d 64 62 29 0a 09 28 6c 65 74 20 itor mdb)..(let
42a0: 6c 6f 6f 70 20 28 28 63 6f 75 6e 74 20 20 20 20 loop ((count
42b0: 20 20 30 29 0a 09 09 20 20 20 28 6e 65 78 74 2d 0)... (next-
42c0: 74 6f 75 63 68 20 30 29 29 20 3b 3b 20 6e 65 78 touch 0)) ;; nex
42d0: 74 2d 74 6f 75 63 68 20 69 73 20 74 68 65 20 74 t-touch is the t
42e0: 69 6d 65 20 77 68 65 72 65 20 77 65 20 6e 65 65 ime where we nee
42f0: 64 20 74 6f 20 75 70 64 61 74 65 20 6c 61 73 74 d to update last
4300: 5f 75 70 64 61 74 65 0a 09 20 20 3b 3b 20 69 66 _update.. ;; if
4310: 20 74 68 65 20 64 62 20 68 61 73 20 62 65 65 6e the db has been
4320: 20 6d 6f 64 69 66 69 65 64 20 77 65 27 64 20 62 modified we'd b
4330: 65 73 74 20 6c 6f 6f 6b 20 61 74 20 74 68 65 20 est look at the
4340: 74 61 73 6b 20 71 75 65 75 65 0a 09 20 20 28 6c task queue.. (l
4350: 65 74 20 28 28 6d 6f 64 74 69 6d 65 20 28 66 69 et ((modtime (fi
4360: 6c 65 2d 6d 6f 64 69 66 69 63 61 74 69 6f 6e 2d le-modification-
4370: 74 69 6d 65 20 6d 65 67 61 74 65 73 74 64 62 70 time megatestdbp
4380: 61 74 68 20 29 29 29 0a 09 20 20 20 20 28 69 66 ath ))).. (if
4390: 20 28 3e 20 6d 6f 64 74 69 6d 65 20 6c 61 73 74 (> modtime last
43a0: 2d 64 62 2d 75 70 64 61 74 65 29 0a 09 09 28 74 -db-update)...(t
43b0: 61 73 6b 73 3a 70 72 6f 63 65 73 73 2d 71 75 65 asks:process-que
43c0: 75 65 20 64 62 20 6d 64 62 20 6c 61 73 74 2d 64 ue db mdb last-d
43d0: 62 2d 75 70 64 61 74 65 20 6d 65 67 61 74 65 73 b-update megates
43e0: 74 64 62 20 6e 65 78 74 2d 74 6f 75 63 68 29 29 tdb next-touch))
43f0: 0a 09 20 20 20 20 3b 3b 20 57 41 52 4e 49 4e 47 .. ;; WARNING
4400: 3a 20 50 6f 73 73 69 62 6c 65 20 72 61 63 65 20 : Possible race
4410: 63 6f 6e 64 69 74 6f 6e 20 68 65 72 65 21 21 0a conditon here!!.
4420: 09 20 20 20 20 3b 3b 20 73 68 6f 75 6c 64 20 74 . ;; should t
4430: 68 69 73 20 75 70 64 61 74 65 20 62 65 20 69 6d his update be im
4440: 6d 65 64 69 61 74 65 6c 79 20 61 66 74 65 72 20 mediately after
4450: 74 68 65 20 74 61 73 6b 2d 67 65 74 2d 61 63 74 the task-get-act
4460: 69 6f 6e 20 63 61 6c 6c 20 61 62 6f 76 65 3f 0a ion call above?.
4470: 09 20 20 20 20 28 69 66 20 28 3e 20 28 63 75 72 . (if (> (cur
4480: 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 20 6e 65 rent-seconds) ne
4490: 78 74 2d 74 6f 75 63 68 29 0a 09 09 28 62 65 67 xt-touch)...(beg
44a0: 69 6e 0a 09 09 20 20 28 74 61 73 6b 73 3a 6d 6f in... (tasks:mo
44b0: 6e 69 74 6f 72 73 2d 75 70 64 61 74 65 20 6d 64 nitors-update md
44c0: 62 29 0a 09 09 20 20 28 6c 6f 6f 70 20 28 2b 20 b)... (loop (+
44d0: 63 6f 75 6e 74 20 31 29 28 2b 20 28 63 75 72 72 count 1)(+ (curr
44e0: 65 6e 74 2d 73 65 63 6f 6e 64 73 29 20 32 34 30 ent-seconds) 240
44f0: 29 29 29 0a 09 09 28 6c 6f 6f 70 20 28 2b 20 63 )))...(loop (+ c
4500: 6f 75 6e 74 20 31 29 20 6e 65 78 74 2d 74 6f 75 ount 1) next-tou
4510: 63 68 29 29 29 29 29 29 29 0a 20 20 20 20 20 20 ch))))))).
4520: 0a 28 64 65 66 69 6e 65 20 28 74 61 73 6b 73 3a .(define (tasks:
4530: 70 72 6f 63 65 73 73 2d 71 75 65 75 65 20 64 62 process-queue db
4540: 20 6d 64 62 29 0a 20 20 28 6c 65 74 2a 20 28 28 mdb). (let* ((
4550: 74 61 73 6b 20 20 20 28 74 61 73 6b 73 3a 73 6e task (tasks:sn
4560: 61 67 2d 61 2d 74 61 73 6b 20 6d 64 62 29 29 0a ag-a-task mdb)).
4570: 09 20 28 61 63 74 69 6f 6e 20 28 69 66 20 74 61 . (action (if ta
4580: 73 6b 20 28 74 61 73 6b 73 3a 74 61 73 6b 2d 67 sk (tasks:task-g
4590: 65 74 2d 61 63 74 69 6f 6e 20 74 61 73 6b 29 20 et-action task)
45a0: 23 66 29 29 29 0a 20 20 20 20 28 69 66 20 61 63 #f))). (if ac
45b0: 74 69 6f 6e 20 28 70 72 69 6e 74 20 22 74 61 73 tion (print "tas
45c0: 6b 73 3a 70 72 6f 63 65 73 73 2d 71 75 65 75 65 ks:process-queue
45d0: 20 74 61 73 6b 3a 20 22 20 74 61 73 6b 29 29 0a task: " task)).
45e0: 20 20 20 20 28 69 66 20 61 63 74 69 6f 6e 0a 09 (if action..
45f0: 28 63 61 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 (case (string->s
4600: 79 6d 62 6f 6c 20 61 63 74 69 6f 6e 29 0a 09 20 ymbol action)..
4610: 20 28 28 72 75 6e 29 20 20 20 20 20 20 20 28 74 ((run) (t
4620: 61 73 6b 73 3a 73 74 61 72 74 2d 72 75 6e 20 20 asks:start-run
4630: 20 64 62 20 6d 64 62 20 74 61 73 6b 29 29 0a 09 db mdb task))..
4640: 20 20 28 28 72 65 6d 6f 76 65 29 20 20 20 20 28 ((remove) (
4650: 74 61 73 6b 73 3a 72 65 6d 6f 76 65 2d 72 75 6e tasks:remove-run
4660: 73 20 64 62 20 6d 64 62 20 74 61 73 6b 29 29 0a s db mdb task)).
4670: 09 20 20 28 28 6c 6f 63 6b 29 20 20 20 20 20 20 . ((lock)
4680: 28 74 61 73 6b 73 3a 6c 6f 63 6b 2d 72 75 6e 73 (tasks:lock-runs
4690: 20 20 20 64 62 20 6d 64 62 20 74 61 73 6b 29 29 db mdb task))
46a0: 0a 09 20 20 3b 3b 20 28 28 6d 6f 6e 69 74 6f 72 .. ;; ((monitor
46b0: 29 20 20 20 28 74 61 73 6b 73 3a 73 74 61 72 74 ) (tasks:start
46c0: 2d 6d 6f 6e 69 74 6f 72 20 64 62 20 74 61 73 6b -monitor db task
46d0: 29 29 0a 09 20 20 28 28 72 6f 6c 6c 75 70 29 20 )).. ((rollup)
46e0: 20 20 20 28 74 61 73 6b 73 3a 72 6f 6c 6c 75 70 (tasks:rollup
46f0: 2d 72 75 6e 73 20 64 62 20 6d 64 62 20 74 61 73 -runs db mdb tas
4700: 6b 29 29 0a 09 20 20 28 28 75 70 64 61 74 65 6d k)).. ((updatem
4710: 65 74 61 29 28 74 61 73 6b 73 3a 75 70 64 61 74 eta)(tasks:updat
4720: 65 2d 6d 65 74 61 20 64 62 20 6d 64 62 20 74 61 e-meta db mdb ta
4730: 73 6b 29 29 0a 09 20 20 28 28 6b 69 6c 6c 29 20 sk)).. ((kill)
4740: 20 20 20 20 20 28 74 61 73 6b 73 3a 6b 69 6c 6c (tasks:kill
4750: 2d 6d 6f 6e 69 74 6f 72 73 20 64 62 20 6d 64 62 -monitors db mdb
4760: 20 74 61 73 6b 29 29 29 29 29 29 0a 0a 28 64 65 task))))))..(de
4770: 66 69 6e 65 20 28 74 61 73 6b 73 3a 67 65 74 2d fine (tasks:get-
4780: 6d 6f 6e 69 74 6f 72 73 20 6d 64 62 29 0a 20 20 monitors mdb).
4790: 28 6c 65 74 20 28 28 72 65 73 20 27 28 29 29 29 (let ((res '()))
47a0: 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f . (sqlite3:fo
47b0: 72 2d 65 61 63 68 2d 72 6f 77 0a 20 20 20 20 20 r-each-row.
47c0: 28 6c 61 6d 62 64 61 20 28 61 20 2e 20 72 65 6d (lambda (a . rem
47d0: 29 0a 20 20 20 20 20 20 20 28 73 65 74 21 20 72 ). (set! r
47e0: 65 73 20 28 63 6f 6e 73 20 28 61 70 70 6c 79 20 es (cons (apply
47f0: 76 65 63 74 6f 72 20 61 20 72 65 6d 29 20 72 65 vector a rem) re
4800: 73 29 29 29 0a 20 20 20 20 20 6d 64 62 0a 20 20 s))). mdb.
4810: 20 20 20 22 53 45 4c 45 43 54 20 69 64 2c 70 69 "SELECT id,pi
4820: 64 2c 73 74 72 66 74 69 6d 65 28 27 25 6d 2f 25 d,strftime('%m/%
4830: 64 2f 25 59 20 25 48 3a 25 4d 27 2c 64 61 74 65 d/%Y %H:%M',date
4840: 74 69 6d 65 28 73 74 61 72 74 5f 74 69 6d 65 2c time(start_time,
4850: 27 75 6e 69 78 65 70 6f 63 68 27 29 2c 27 6c 6f 'unixepoch'),'lo
4860: 63 61 6c 74 69 6d 65 27 29 2c 73 74 72 66 74 69 caltime'),strfti
4870: 6d 65 28 27 25 6d 2f 25 64 2f 25 59 20 25 48 3a me('%m/%d/%Y %H:
4880: 25 4d 3a 25 53 27 2c 64 61 74 65 74 69 6d 65 28 %M:%S',datetime(
4890: 6c 61 73 74 5f 75 70 64 61 74 65 2c 27 75 6e 69 last_update,'uni
48a0: 78 65 70 6f 63 68 27 29 2c 27 6c 6f 63 61 6c 74 xepoch'),'localt
48b0: 69 6d 65 27 29 2c 68 6f 73 74 6e 61 6d 65 2c 75 ime'),hostname,u
48c0: 73 65 72 6e 61 6d 65 20 46 52 4f 4d 20 6d 6f 6e sername FROM mon
48d0: 69 74 6f 72 73 20 4f 52 44 45 52 20 42 59 20 6c itors ORDER BY l
48e0: 61 73 74 5f 75 70 64 61 74 65 20 41 53 43 3b 22 ast_update ASC;"
48f0: 29 0a 20 20 20 20 28 72 65 76 65 72 73 65 20 72 ). (reverse r
4900: 65 73 29 0a 20 20 20 20 29 29 0a 0a 28 64 65 66 es). ))..(def
4910: 69 6e 65 20 28 74 61 73 6b 73 3a 74 61 73 6b 73 ine (tasks:tasks
4920: 2d 3e 74 65 78 74 20 74 61 73 6b 73 29 0a 20 20 ->text tasks).
4930: 28 6c 65 74 20 28 28 66 6d 74 73 74 72 20 22 7e (let ((fmtstr "~
4940: 31 30 61 7e 31 30 61 7e 31 30 61 7e 31 32 61 7e 10a~10a~10a~12a~
4950: 32 30 61 7e 31 32 61 7e 31 32 61 7e 31 32 61 7e 20a~12a~12a~12a~
4960: 31 30 61 22 29 29 0a 20 20 20 20 28 63 6f 6e 63 10a")). (conc
4970: 20 28 66 6f 72 6d 61 74 20 23 66 20 66 6d 74 73 (format #f fmts
4980: 74 72 20 22 69 64 22 20 22 61 63 74 69 6f 6e 22 tr "id" "action"
4990: 20 22 6f 77 6e 65 72 22 20 22 73 74 61 74 65 22 "owner" "state"
49a0: 20 22 74 61 72 67 65 74 22 20 22 72 75 6e 6e 61 "target" "runna
49b0: 6d 65 22 20 22 74 65 73 74 70 61 74 74 73 22 20 me" "testpatts"
49c0: 22 69 74 65 6d 70 61 74 74 73 22 20 22 70 61 72 "itempatts" "par
49d0: 61 6d 73 22 29 20 22 5c 6e 22 0a 09 20 20 28 73 ams") "\n".. (s
49e0: 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
49f0: 65 20 0a 09 20 20 20 28 6d 61 70 20 28 6c 61 6d e .. (map (lam
4a00: 62 64 61 20 28 74 61 73 6b 29 0a 09 09 20 20 28 bda (task)... (
4a10: 66 6f 72 6d 61 74 20 23 66 20 66 6d 74 73 74 72 format #f fmtstr
4a20: 0a 09 09 09 20 20 28 74 61 73 6b 73 3a 74 61 73 .... (tasks:tas
4a30: 6b 2d 67 65 74 2d 69 64 20 20 20 20 20 74 61 73 k-get-id tas
4a40: 6b 29 0a 09 09 09 20 20 28 74 61 73 6b 73 3a 74 k).... (tasks:t
4a50: 61 73 6b 2d 67 65 74 2d 61 63 74 69 6f 6e 20 74 ask-get-action t
4a60: 61 73 6b 29 0a 09 09 09 20 20 28 74 61 73 6b 73 ask).... (tasks
4a70: 3a 74 61 73 6b 2d 67 65 74 2d 6f 77 6e 65 72 20 :task-get-owner
4a80: 20 74 61 73 6b 29 0a 09 09 09 20 20 28 74 61 73 task).... (tas
4a90: 6b 73 3a 74 61 73 6b 2d 67 65 74 2d 73 74 61 74 ks:task-get-stat
4aa0: 65 20 20 74 61 73 6b 29 0a 09 09 09 20 20 28 74 e task).... (t
4ab0: 61 73 6b 73 3a 74 61 73 6b 2d 67 65 74 2d 74 61 asks:task-get-ta
4ac0: 72 67 65 74 20 74 61 73 6b 29 0a 09 09 09 20 20 rget task)....
4ad0: 28 74 61 73 6b 73 3a 74 61 73 6b 2d 67 65 74 2d (tasks:task-get-
4ae0: 6e 61 6d 65 20 20 20 74 61 73 6b 29 0a 09 09 09 name task)....
4af0: 20 20 28 74 61 73 6b 73 3a 74 61 73 6b 2d 67 65 (tasks:task-ge
4b00: 74 2d 74 65 73 74 20 20 20 74 61 73 6b 29 0a 09 t-test task)..
4b10: 09 09 20 20 28 74 61 73 6b 73 3a 74 61 73 6b 2d .. (tasks:task-
4b20: 67 65 74 2d 69 74 65 6d 20 20 20 74 61 73 6b 29 get-item task)
4b30: 0a 09 09 09 20 20 28 74 61 73 6b 73 3a 74 61 73 .... (tasks:tas
4b40: 6b 2d 67 65 74 2d 70 61 72 61 6d 73 20 74 61 73 k-get-params tas
4b50: 6b 29 29 29 0a 09 09 74 61 73 6b 73 29 20 22 5c k)))...tasks) "\
4b60: 6e 22 29 29 29 29 0a 20 20 20 0a 28 64 65 66 69 n")))). .(defi
4b70: 6e 65 20 28 74 61 73 6b 73 3a 6d 6f 6e 69 74 6f ne (tasks:monito
4b80: 72 73 2d 3e 74 65 78 74 2d 74 61 62 6c 65 20 6d rs->text-table m
4b90: 6f 6e 69 74 6f 72 73 29 0a 20 20 28 6c 65 74 20 onitors). (let
4ba0: 28 28 66 6d 74 73 74 72 20 22 7e 34 61 7e 38 61 ((fmtstr "~4a~8a
4bb0: 7e 32 30 61 7e 32 30 61 7e 31 30 61 7e 31 30 61 ~20a~20a~10a~10a
4bc0: 22 29 29 0a 20 20 20 20 28 63 6f 6e 63 20 28 66 ")). (conc (f
4bd0: 6f 72 6d 61 74 20 23 66 20 66 6d 74 73 74 72 20 ormat #f fmtstr
4be0: 22 69 64 22 20 22 70 69 64 22 20 22 73 74 61 72 "id" "pid" "star
4bf0: 74 20 74 69 6d 65 22 20 22 6c 61 73 74 20 75 70 t time" "last up
4c00: 64 61 74 65 22 20 22 68 6f 73 74 6e 61 6d 65 22 date" "hostname"
4c10: 20 22 75 73 65 72 22 29 20 22 5c 6e 22 0a 09 20 "user") "\n"..
4c20: 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp
4c30: 65 72 73 65 20 0a 09 20 20 20 28 6d 61 70 20 28 erse .. (map (
4c40: 6c 61 6d 62 64 61 20 28 6d 6f 6e 69 74 6f 72 29 lambda (monitor)
4c50: 0a 09 09 20 20 28 66 6f 72 6d 61 74 20 23 66 20 ... (format #f
4c60: 66 6d 74 73 74 72 0a 09 09 09 20 20 28 74 61 73 fmtstr.... (tas
4c70: 6b 73 3a 6d 6f 6e 69 74 6f 72 2d 67 65 74 2d 69 ks:monitor-get-i
4c80: 64 20 20 20 20 20 20 20 20 20 20 6d 6f 6e 69 74 d monit
4c90: 6f 72 29 0a 09 09 09 20 20 28 74 61 73 6b 73 3a or).... (tasks:
4ca0: 6d 6f 6e 69 74 6f 72 2d 67 65 74 2d 70 69 64 20 monitor-get-pid
4cb0: 20 20 20 20 20 20 20 20 6d 6f 6e 69 74 6f 72 29 monitor)
4cc0: 0a 09 09 09 20 20 28 74 61 73 6b 73 3a 6d 6f 6e .... (tasks:mon
4cd0: 69 74 6f 72 2d 67 65 74 2d 73 74 61 72 74 5f 74 itor-get-start_t
4ce0: 69 6d 65 20 20 6d 6f 6e 69 74 6f 72 29 0a 09 09 ime monitor)...
4cf0: 09 20 20 28 74 61 73 6b 73 3a 6d 6f 6e 69 74 6f . (tasks:monito
4d00: 72 2d 67 65 74 2d 6c 61 73 74 5f 75 70 64 61 74 r-get-last_updat
4d10: 65 20 6d 6f 6e 69 74 6f 72 29 0a 09 09 09 20 20 e monitor)....
4d20: 28 74 61 73 6b 73 3a 6d 6f 6e 69 74 6f 72 2d 67 (tasks:monitor-g
4d30: 65 74 2d 68 6f 73 74 6e 61 6d 65 20 20 20 20 6d et-hostname m
4d40: 6f 6e 69 74 6f 72 29 0a 09 09 09 20 20 28 74 61 onitor).... (ta
4d50: 73 6b 73 3a 6d 6f 6e 69 74 6f 72 2d 67 65 74 2d sks:monitor-get-
4d60: 75 73 65 72 6e 61 6d 65 20 20 20 20 6d 6f 6e 69 username moni
4d70: 74 6f 72 29 29 29 0a 09 09 6d 6f 6e 69 74 6f 72 tor)))...monitor
4d80: 73 29 0a 09 20 20 20 22 5c 6e 22 29 29 29 29 0a s).. "\n")))).
4d90: 20 20 20 0a 3b 3b 20 75 70 64 61 74 65 20 74 68 .;; update th
4da0: 65 20 6c 61 73 74 5f 75 70 64 61 74 65 20 66 69 e last_update fi
4db0: 65 6c 64 20 77 69 74 68 20 74 68 65 20 63 75 72 eld with the cur
4dc0: 72 65 6e 74 20 74 69 6d 65 20 61 6e 64 0a 3b 3b rent time and.;;
4dd0: 20 69 66 20 61 6e 79 20 6d 6f 6e 69 74 6f 72 73 if any monitors
4de0: 20 61 70 70 65 61 72 20 64 65 61 64 2c 20 72 65 appear dead, re
4df0: 6d 6f 76 65 20 74 68 65 6d 0a 28 64 65 66 69 6e move them.(defin
4e00: 65 20 28 74 61 73 6b 73 3a 6d 6f 6e 69 74 6f 72 e (tasks:monitor
4e10: 73 2d 75 70 64 61 74 65 20 6d 64 62 29 0a 20 20 s-update mdb).
4e20: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
4e30: 20 6d 64 62 20 22 55 50 44 41 54 45 20 6d 6f 6e mdb "UPDATE mon
4e40: 69 74 6f 72 73 20 53 45 54 20 6c 61 73 74 5f 75 itors SET last_u
4e50: 70 64 61 74 65 3d 73 74 72 66 74 69 6d 65 28 27 pdate=strftime('
4e60: 25 73 27 2c 27 6e 6f 77 27 29 20 57 48 45 52 45 %s','now') WHERE
4e70: 20 70 69 64 3d 3f 20 41 4e 44 20 68 6f 73 74 6e pid=? AND hostn
4e80: 61 6d 65 3d 3f 3b 22 0a 09 09 09 20 20 28 63 75 ame=?;".... (cu
4e90: 72 72 65 6e 74 2d 70 72 6f 63 65 73 73 2d 69 64 rrent-process-id
4ea0: 29 0a 09 09 09 20 20 28 67 65 74 2d 68 6f 73 74 ).... (get-host
4eb0: 2d 6e 61 6d 65 29 29 0a 20 20 28 6c 65 74 20 28 -name)). (let (
4ec0: 28 64 65 61 64 6c 69 73 74 20 27 28 29 29 29 0a (deadlist '())).
4ed0: 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 (sqlite3:for
4ee0: 2d 65 61 63 68 2d 72 6f 77 0a 20 20 20 20 20 28 -each-row. (
4ef0: 6c 61 6d 62 64 61 20 28 69 64 20 70 69 64 20 68 lambda (id pid h
4f00: 6f 73 74 20 6c 61 73 74 2d 75 70 64 61 74 65 20 ost last-update
4f10: 64 65 6c 74 61 29 0a 20 20 20 20 20 20 20 28 70 delta). (p
4f20: 72 69 6e 74 20 22 47 6f 69 6e 67 20 74 6f 20 64 rint "Going to d
4f30: 65 6c 65 74 65 20 73 74 61 6c 65 20 72 65 63 6f elete stale reco
4f40: 72 64 20 66 6f 72 20 6d 6f 6e 69 74 6f 72 20 77 rd for monitor w
4f50: 69 74 68 20 70 69 64 20 22 20 70 69 64 20 22 20 ith pid " pid "
4f60: 6f 6e 20 68 6f 73 74 20 22 20 68 6f 73 74 20 22 on host " host "
4f70: 20 6c 61 73 74 20 75 70 64 61 74 65 64 20 22 20 last updated "
4f80: 64 65 6c 74 61 20 22 20 73 65 63 6f 6e 64 73 20 delta " seconds
4f90: 61 67 6f 22 29 0a 20 20 20 20 20 20 20 28 73 65 ago"). (se
4fa0: 74 21 20 64 65 61 64 6c 69 73 74 20 28 63 6f 6e t! deadlist (con
4fb0: 73 20 69 64 20 64 65 61 64 6c 69 73 74 29 29 29 s id deadlist)))
4fc0: 0a 20 20 20 20 20 6d 64 62 20 0a 20 20 20 20 20 . mdb .
4fd0: 22 53 45 4c 45 43 54 20 69 64 2c 70 69 64 2c 68 "SELECT id,pid,h
4fe0: 6f 73 74 6e 61 6d 65 2c 6c 61 73 74 5f 75 70 64 ostname,last_upd
4ff0: 61 74 65 2c 73 74 72 66 74 69 6d 65 28 27 25 73 ate,strftime('%s
5000: 27 2c 27 6e 6f 77 27 29 2d 6c 61 73 74 5f 75 70 ','now')-last_up
5010: 64 61 74 65 20 41 53 20 64 65 6c 74 61 20 46 52 date AS delta FR
5020: 4f 4d 20 6d 6f 6e 69 74 6f 72 73 20 57 48 45 52 OM monitors WHER
5030: 45 20 64 65 6c 74 61 20 3e 20 37 30 30 3b 22 29 E delta > 700;")
5040: 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 . (sqlite3:ex
5050: 65 63 75 74 65 20 6d 64 62 20 28 63 6f 6e 63 20 ecute mdb (conc
5060: 22 44 45 4c 45 54 45 20 46 52 4f 4d 20 6d 6f 6e "DELETE FROM mon
5070: 69 74 6f 72 73 20 57 48 45 52 45 20 69 64 20 49 itors WHERE id I
5080: 4e 20 28 27 22 20 28 73 74 72 69 6e 67 2d 69 6e N ('" (string-in
5090: 74 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 63 tersperse (map c
50a0: 6f 6e 63 20 64 65 61 64 6c 69 73 74 29 20 22 27 onc deadlist) "'
50b0: 2c 27 22 29 20 22 27 29 3b 22 29 29 29 0a 20 20 ,'") "');"))).
50c0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 61 73 6b )..(define (task
50d0: 73 3a 72 65 6d 6f 76 65 2d 6d 6f 6e 69 74 6f 72 s:remove-monitor
50e0: 2d 72 65 63 6f 72 64 20 6d 64 62 29 0a 20 20 28 -record mdb). (
50f0: 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 sqlite3:execute
5100: 6d 64 62 20 22 44 45 4c 45 54 45 20 46 52 4f 4d mdb "DELETE FROM
5110: 20 6d 6f 6e 69 74 6f 72 73 20 57 48 45 52 45 20 monitors WHERE
5120: 70 69 64 3d 3f 20 41 4e 44 20 68 6f 73 74 6e 61 pid=? AND hostna
5130: 6d 65 3d 3f 3b 22 0a 09 09 20 20 20 28 63 75 72 me=?;"... (cur
5140: 72 65 6e 74 2d 70 72 6f 63 65 73 73 2d 69 64 29 rent-process-id)
5150: 0a 09 09 20 20 20 28 67 65 74 2d 68 6f 73 74 2d ... (get-host-
5160: 6e 61 6d 65 29 29 29 0a 0a 28 64 65 66 69 6e 65 name)))..(define
5170: 20 28 74 61 73 6b 73 3a 73 65 74 2d 73 74 61 74 (tasks:set-stat
5180: 65 20 6d 64 62 20 74 61 73 6b 2d 69 64 20 73 74 e mdb task-id st
5190: 61 74 65 29 0a 20 20 28 73 71 6c 69 74 65 33 3a ate). (sqlite3:
51a0: 65 78 65 63 75 74 65 20 6d 64 62 20 22 55 50 44 execute mdb "UPD
51b0: 41 54 45 20 74 61 73 6b 73 5f 71 75 65 75 65 20 ATE tasks_queue
51c0: 53 45 54 20 73 74 61 74 65 3d 3f 20 57 48 45 52 SET state=? WHER
51d0: 45 20 69 64 3d 3f 3b 22 20 0a 09 09 20 20 20 73 E id=?;" ... s
51e0: 74 61 74 65 20 0a 09 09 20 20 20 74 61 73 6b 2d tate ... task-
51f0: 69 64 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d id))..;;========
5200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5220: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5230: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
5240: 3b 20 54 68 65 20 72 6f 75 74 69 6e 65 73 20 74 ; The routines t
5250: 6f 20 70 72 6f 63 65 73 73 20 74 61 73 6b 73 0a o process tasks.
5260: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
5270: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5280: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5290: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
52a0: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 4e 4f 54 ========..;; NOT
52b0: 45 3a 20 49 74 20 6d 69 67 68 74 20 62 65 20 67 E: It might be g
52c0: 6f 6f 64 20 74 6f 20 61 64 64 20 6f 6e 65 20 6d ood to add one m
52d0: 6f 72 65 20 6c 61 79 65 72 20 6f 66 20 63 68 65 ore layer of che
52e0: 63 6b 69 6e 67 20 74 6f 20 65 6e 73 75 72 65 0a cking to ensure.
52f0: 3b 3b 20 20 20 20 20 20 20 74 68 61 74 20 6e 6f ;; that no
5300: 20 74 61 73 6b 20 67 65 74 73 20 72 75 6e 20 69 task gets run i
5310: 6e 20 70 61 72 61 6c 6c 65 6c 2e 0a 0a 28 64 65 n parallel...(de
5320: 66 69 6e 65 20 28 74 61 73 6b 73 3a 73 74 61 72 fine (tasks:star
5330: 74 2d 72 75 6e 20 64 62 20 6d 64 62 20 74 61 73 t-run db mdb tas
5340: 6b 29 0a 20 20 28 6c 65 74 20 28 28 66 6c 61 67 k). (let ((flag
5350: 73 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 s (make-hash-tab
5360: 6c 65 29 29 29 0a 20 20 20 20 28 68 61 73 68 2d le))). (hash-
5370: 74 61 62 6c 65 2d 73 65 74 21 20 66 6c 61 67 73 table-set! flags
5380: 20 22 2d 72 65 72 75 6e 22 20 22 4e 4f 54 5f 53 "-rerun" "NOT_S
5390: 54 41 52 54 45 44 22 29 0a 20 20 20 20 28 69 66 TARTED"). (if
53a0: 20 28 6e 6f 74 20 28 73 74 72 69 6e 67 3d 3f 20 (not (string=?
53b0: 28 74 61 73 6b 73 3a 74 61 73 6b 2d 67 65 74 2d (tasks:task-get-
53c0: 70 61 72 61 6d 73 20 74 61 73 6b 29 20 22 22 29 params task) "")
53d0: 29 0a 09 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 )..(hash-table-s
53e0: 65 74 21 20 66 6c 61 67 73 20 22 2d 73 65 74 76 et! flags "-setv
53f0: 61 72 73 22 20 28 74 61 73 6b 73 3a 74 61 73 6b ars" (tasks:task
5400: 2d 67 65 74 2d 70 61 72 61 6d 73 20 74 61 73 6b -get-params task
5410: 29 29 29 0a 20 20 20 20 28 70 72 69 6e 74 20 22 ))). (print "
5420: 53 74 61 72 74 69 6e 67 20 72 75 6e 20 22 20 74 Starting run " t
5430: 61 73 6b 29 0a 20 20 20 20 3b 3b 20 73 69 6c 6c ask). ;; sill
5440: 79 6e 65 73 73 2c 20 6a 75 73 74 20 63 61 6c 6c yness, just call
5450: 20 74 68 65 20 64 61 6d 6e 20 72 6f 75 74 69 6e the damn routin
5460: 65 20 77 69 74 68 20 74 68 65 20 74 61 73 6b 20 e with the task
5470: 76 65 63 74 6f 72 20 61 6e 64 20 62 65 20 64 6f vector and be do
5480: 6e 65 20 77 69 74 68 20 69 74 2e 20 46 49 58 4d ne with it. FIXM
5490: 45 20 53 4f 4d 45 44 41 59 0a 20 20 20 20 28 72 E SOMEDAY. (r
54a0: 75 6e 73 3a 72 75 6e 2d 74 65 73 74 73 20 64 62 uns:run-tests db
54b0: 0a 09 09 20 20 20 20 28 74 61 73 6b 73 3a 74 61 ... (tasks:ta
54c0: 73 6b 2d 67 65 74 2d 74 61 72 67 65 74 20 74 61 sk-get-target ta
54d0: 73 6b 29 0a 09 09 20 20 20 20 28 74 61 73 6b 73 sk)... (tasks
54e0: 3a 74 61 73 6b 2d 67 65 74 2d 6e 61 6d 65 20 20 :task-get-name
54f0: 20 74 61 73 6b 29 0a 09 09 20 20 20 20 28 74 61 task)... (ta
5500: 73 6b 73 3a 74 61 73 6b 2d 67 65 74 2d 74 65 73 sks:task-get-tes
5510: 74 20 20 20 74 61 73 6b 29 0a 09 09 20 20 20 20 t task)...
5520: 28 74 61 73 6b 73 3a 74 61 73 6b 2d 67 65 74 2d (tasks:task-get-
5530: 69 74 65 6d 20 20 20 74 61 73 6b 29 0a 09 09 20 item task)...
5540: 20 20 20 28 74 61 73 6b 73 3a 74 61 73 6b 2d 67 (tasks:task-g
5550: 65 74 2d 6f 77 6e 65 72 20 20 74 61 73 6b 29 0a et-owner task).
5560: 09 09 20 20 20 20 66 6c 61 67 73 29 0a 20 20 20 .. flags).
5570: 20 28 74 61 73 6b 73 3a 73 65 74 2d 73 74 61 74 (tasks:set-stat
5580: 65 20 6d 64 62 20 28 74 61 73 6b 73 3a 74 61 73 e mdb (tasks:tas
5590: 6b 2d 67 65 74 2d 69 64 20 74 61 73 6b 29 20 22 k-get-id task) "
55a0: 77 61 69 74 69 6e 67 22 29 29 29 0a 0a 28 64 65 waiting")))..(de
55b0: 66 69 6e 65 20 28 74 61 73 6b 73 3a 72 6f 6c 6c fine (tasks:roll
55c0: 75 70 2d 72 75 6e 73 20 64 62 20 6d 64 62 20 74 up-runs db mdb t
55d0: 61 73 6b 29 0a 20 20 28 6c 65 74 2a 20 28 28 66 ask). (let* ((f
55e0: 6c 61 67 73 20 28 6d 61 6b 65 2d 68 61 73 68 2d lags (make-hash-
55f0: 74 61 62 6c 65 29 29 20 0a 09 20 28 6b 65 79 73 table)) .. (keys
5600: 20 20 28 64 62 3a 67 65 74 2d 6b 65 79 73 20 64 (db:get-keys d
5610: 62 29 29 0a 09 20 28 6b 65 79 76 61 6c 6c 73 74 b)).. (keyvallst
5620: 20 28 6b 65 79 73 3a 74 61 72 67 65 74 2d 3e 6b (keys:target->k
5630: 65 79 76 61 6c 20 6b 65 79 73 20 28 74 61 73 6b eyval keys (task
5640: 73 3a 74 61 73 6b 2d 67 65 74 2d 74 61 72 67 65 s:task-get-targe
5650: 74 20 74 61 73 6b 29 29 29 29 0a 20 20 20 20 3b t task)))). ;
5660: 3b 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 ; (hash-table-se
5670: 74 21 20 66 6c 61 67 73 20 22 2d 72 65 72 75 6e t! flags "-rerun
5680: 22 20 22 4e 4f 54 5f 53 54 41 52 54 45 44 22 29 " "NOT_STARTED")
5690: 0a 20 20 20 20 28 70 72 69 6e 74 20 22 53 74 61 . (print "Sta
56a0: 72 74 69 6e 67 20 72 6f 6c 6c 75 70 20 22 20 74 rting rollup " t
56b0: 61 73 6b 29 0a 20 20 20 20 3b 3b 20 73 69 6c 6c ask). ;; sill
56c0: 79 6e 65 73 73 2c 20 6a 75 73 74 20 63 61 6c 6c yness, just call
56d0: 20 74 68 65 20 64 61 6d 6e 20 72 6f 75 74 69 6e the damn routin
56e0: 65 20 77 69 74 68 20 74 68 65 20 74 61 73 6b 20 e with the task
56f0: 76 65 63 74 6f 72 20 61 6e 64 20 62 65 20 64 6f vector and be do
5700: 6e 65 20 77 69 74 68 20 69 74 2e 20 46 49 58 4d ne with it. FIXM
5710: 45 20 53 4f 4d 45 44 41 59 0a 20 20 20 20 28 72 E SOMEDAY. (r
5720: 75 6e 73 3a 72 6f 6c 6c 75 70 2d 72 75 6e 20 64 uns:rollup-run d
5730: 62 0a 09 09 20 20 20 20 20 6b 65 79 73 20 0a 09 b... keys ..
5740: 09 20 20 20 20 20 6b 65 79 76 61 6c 6c 73 74 0a . keyvallst.
5750: 09 09 20 20 20 20 20 28 74 61 73 6b 73 3a 74 61 .. (tasks:ta
5760: 73 6b 2d 67 65 74 2d 6e 61 6d 65 20 20 74 61 73 sk-get-name tas
5770: 6b 29 0a 09 09 20 20 20 20 20 28 74 61 73 6b 73 k)... (tasks
5780: 3a 74 61 73 6b 2d 67 65 74 2d 6f 77 6e 65 72 20 :task-get-owner
5790: 20 74 61 73 6b 29 29 0a 20 20 20 20 28 74 61 73 task)). (tas
57a0: 6b 73 3a 73 65 74 2d 73 74 61 74 65 20 6d 64 62 ks:set-state mdb
57b0: 20 28 74 61 73 6b 73 3a 74 61 73 6b 2d 67 65 74 (tasks:task-get
57c0: 2d 69 64 20 74 61 73 6b 29 20 22 77 61 69 74 69 -id task) "waiti
57d0: 6e 67 22 29 29 29 0a ng"))).