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 20 20 20 20 20 28 63 6f 6e 63 20 ath (conc
0320: 2a 74 6f 70 70 61 74 68 2a 20 22 2f 6d 6f 6e 69 *toppath* "/moni
0330: 74 6f 72 2e 64 62 22 29 29 0a 09 20 28 65 78 69 tor.db")).. (exi
0340: 73 74 73 20 20 20 20 20 20 20 28 66 69 6c 65 2d sts (file-
0350: 65 78 69 73 74 73 3f 20 64 62 70 61 74 68 29 29 exists? dbpath))
0360: 0a 09 20 28 77 72 69 74 65 2d 61 63 63 65 73 73 .. (write-access
0370: 20 28 66 69 6c 65 2d 77 72 69 74 65 2d 61 63 63 (file-write-acc
0380: 65 73 73 3f 20 64 62 70 61 74 68 29 29 0a 09 20 ess? dbpath))..
0390: 28 6d 64 62 20 20 20 20 20 20 20 20 20 20 28 73 (mdb (s
03a0: 71 6c 69 74 65 33 3a 6f 70 65 6e 2d 64 61 74 61 qlite3:open-data
03b0: 62 61 73 65 20 64 62 70 61 74 68 29 29 20 3b 3b base dbpath)) ;;
03c0: 20 28 6e 65 76 65 72 2d 67 69 76 65 2d 75 70 2d (never-give-up-
03d0: 6f 70 65 6e 2d 64 62 20 64 62 70 61 74 68 29 29 open-db dbpath))
03e0: 0a 09 20 28 68 61 6e 64 6c 65 72 20 20 20 20 20 .. (handler
03f0: 20 28 6d 61 6b 65 2d 62 75 73 79 2d 74 69 6d 65 (make-busy-time
0400: 6f 75 74 20 33 36 30 30 30 29 29 29 0a 20 20 20 out 36000))).
0410: 20 28 69 66 20 28 61 6e 64 20 65 78 69 73 74 73 (if (and exists
0420: 0a 09 20 20 20 20 20 28 6e 6f 74 20 77 72 69 74 .. (not writ
0430: 65 2d 61 63 63 65 73 73 29 29 0a 09 28 73 65 74 e-access))..(set
0440: 21 20 2a 64 62 2d 77 72 69 74 65 2d 61 63 63 65 ! *db-write-acce
0450: 73 73 2a 20 77 72 69 74 65 2d 61 63 63 65 73 73 ss* write-access
0460: 29 29 20 3b 3b 20 6f 6e 6c 79 20 75 6e 73 65 74 )) ;; only unset
0470: 20 73 6f 20 6f 74 68 65 72 20 64 62 27 73 20 61 so other db's a
0480: 6c 73 6f 20 63 61 6e 20 75 73 65 20 74 68 69 73 lso can use this
0490: 20 63 6f 6e 74 72 6f 6c 0a 20 20 20 20 28 73 71 control. (sq
04a0: 6c 69 74 65 33 3a 73 65 74 2d 62 75 73 79 2d 68 lite3:set-busy-h
04b0: 61 6e 64 6c 65 72 21 20 6d 64 62 20 68 61 6e 64 andler! mdb hand
04c0: 6c 65 72 29 0a 20 20 20 20 28 73 71 6c 69 74 65 ler). (sqlite
04d0: 33 3a 65 78 65 63 75 74 65 20 6d 64 62 20 28 63 3:execute mdb (c
04e0: 6f 6e 63 20 22 50 52 41 47 4d 41 20 73 79 6e 63 onc "PRAGMA sync
04f0: 68 72 6f 6e 6f 75 73 20 3d 20 30 3b 22 29 29 0a hronous = 0;")).
0500: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 65 78 69 (if (not exi
0510: 73 74 73 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 sts)..(begin..
0520: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
0530: 20 6d 64 62 20 22 43 52 45 41 54 45 20 54 41 42 mdb "CREATE TAB
0540: 4c 45 20 49 46 20 4e 4f 54 20 45 58 49 53 54 53 LE IF NOT EXISTS
0550: 20 74 61 73 6b 73 5f 71 75 65 75 65 20 28 69 64 tasks_queue (id
0560: 20 49 4e 54 45 47 45 52 20 50 52 49 4d 41 52 59 INTEGER PRIMARY
0570: 20 4b 45 59 2c 0a 20 20 20 20 20 20 20 20 20 20 KEY,.
0580: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0590: 20 20 20 20 20 20 61 63 74 69 6f 6e 20 54 45 58 action TEX
05a0: 54 20 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 T DEFAULT '',.
05b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
05c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6f 77 ow
05d0: 6e 65 72 20 54 45 58 54 2c 0a 20 20 20 20 20 20 ner TEXT,.
05e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
05f0: 20 20 20 20 20 20 20 20 20 20 73 74 61 74 65 20 state
0600: 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 6e 65 TEXT DEFAULT 'ne
0610: 77 27 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 w',.
0620: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0630: 20 20 20 20 74 61 72 67 65 74 20 54 45 58 54 20 target TEXT
0640: 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 DEFAULT '',.
0650: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0660: 20 20 20 20 20 20 20 20 20 20 20 20 6e 61 6d 65 name
0670: 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 27 TEXT DEFAULT ''
0680: 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ,.
0690: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
06a0: 20 20 74 65 73 74 20 54 45 58 54 20 44 45 46 41 test TEXT DEFA
06b0: 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 20 20 ULT '',.
06c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
06d0: 20 20 20 20 20 20 20 20 69 74 65 6d 20 54 45 58 item TEX
06e0: 54 20 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 T DEFAULT '',.
06f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0700: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6b 65 ke
0710: 79 6c 6f 63 6b 20 54 45 58 54 2c 0a 20 20 20 20 ylock TEXT,.
0720: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0730: 20 20 20 20 20 20 20 20 20 20 20 20 70 61 72 61 para
0740: 6d 73 20 54 45 58 54 2c 0a 20 20 20 20 20 20 20 ms TEXT,.
0750: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0760: 20 20 20 20 20 20 20 20 20 63 72 65 61 74 69 6f creatio
0770: 6e 5f 74 69 6d 65 20 54 49 4d 45 53 54 41 4d 50 n_time TIMESTAMP
0780: 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ,.
0790: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
07a0: 20 20 65 78 65 63 75 74 69 6f 6e 5f 74 69 6d 65 execution_time
07b0: 20 54 49 4d 45 53 54 41 4d 50 29 3b 22 29 0a 09 TIMESTAMP);")..
07c0: 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 (sqlite3:execu
07d0: 74 65 20 6d 64 62 20 22 43 52 45 41 54 45 20 54 te mdb "CREATE T
07e0: 41 42 4c 45 20 49 46 20 4e 4f 54 20 45 58 49 53 ABLE IF NOT EXIS
07f0: 54 53 20 6d 6f 6e 69 74 6f 72 73 20 28 69 64 20 TS monitors (id
0800: 49 4e 54 45 47 45 52 20 50 52 49 4d 41 52 59 20 INTEGER PRIMARY
0810: 4b 45 59 2c 0a 20 20 20 20 20 20 20 20 20 20 20 KEY,.
0820: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0830: 20 20 20 20 20 70 69 64 20 49 4e 54 45 47 45 52 pid INTEGER
0840: 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ,.
0850: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0860: 20 20 73 74 61 72 74 5f 74 69 6d 65 20 54 49 4d start_time TIM
0870: 45 53 54 41 4d 50 2c 0a 20 20 20 20 20 20 20 20 ESTAMP,.
0880: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0890: 20 20 20 20 20 20 20 20 6c 61 73 74 5f 75 70 64 last_upd
08a0: 61 74 65 20 54 49 4d 45 53 54 41 4d 50 2c 0a 20 ate TIMESTAMP,.
08b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
08c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 68 h
08d0: 6f 73 74 6e 61 6d 65 20 54 45 58 54 2c 0a 20 20 ostname TEXT,.
08e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
08f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 75 73 us
0900: 65 72 6e 61 6d 65 20 54 45 58 54 2c 0a 20 20 20 ername TEXT,.
0910: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0920: 20 20 20 20 20 20 20 20 20 20 20 20 43 4f 4e 53 CONS
0930: 54 52 41 49 4e 54 20 6d 6f 6e 69 74 6f 72 73 5f TRAINT monitors_
0940: 63 6f 6e 73 74 72 61 69 6e 74 20 55 4e 49 51 55 constraint UNIQU
0950: 45 20 28 70 69 64 2c 68 6f 73 74 6e 61 6d 65 29 E (pid,hostname)
0960: 29 3b 22 29 0a 09 20 20 28 73 71 6c 69 74 65 33 );").. (sqlite3
0970: 3a 65 78 65 63 75 74 65 20 6d 64 62 20 22 43 52 :execute mdb "CR
0980: 45 41 54 45 20 54 41 42 4c 45 20 49 46 20 4e 4f EATE TABLE IF NO
0990: 54 20 45 58 49 53 54 53 20 73 65 72 76 65 72 73 T EXISTS servers
09a0: 20 28 69 64 20 49 4e 54 45 47 45 52 20 50 52 49 (id INTEGER PRI
09b0: 4d 41 52 59 20 4b 45 59 2c 0a 20 20 20 20 20 20 MARY KEY,.
09c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
09d0: 20 20 20 20 20 20 20 20 20 20 20 20 70 69 64 20 pid
09e0: 49 4e 54 45 47 45 52 2c 0a 20 20 20 20 20 20 20 INTEGER,.
09f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0a00: 20 20 20 20 20 20 20 20 20 20 20 69 6e 74 65 72 inter
0a10: 66 61 63 65 20 54 45 58 54 2c 0a 20 20 20 20 20 face TEXT,.
0a20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0a30: 20 20 20 20 20 20 20 20 20 20 20 20 20 68 6f 73 hos
0a40: 74 6e 61 6d 65 20 54 45 58 54 2c 0a 20 20 20 20 tname TEXT,.
0a50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0a60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 70 6f po
0a70: 72 74 20 49 4e 54 45 47 45 52 2c 0a 20 20 20 20 rt INTEGER,.
0a80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0a90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 70 75 pu
0aa0: 62 70 6f 72 74 20 49 4e 54 45 47 45 52 2c 0a 20 bport INTEGER,.
0ab0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ac0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ad0: 20 73 74 61 72 74 5f 74 69 6d 65 20 54 49 4d 45 start_time TIME
0ae0: 53 54 41 4d 50 2c 0a 20 20 20 20 20 20 20 20 20 STAMP,.
0af0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0b00: 20 20 20 20 20 20 20 20 20 70 72 69 6f 72 69 74 priorit
0b10: 79 20 49 4e 54 45 47 45 52 2c 0a 20 20 20 20 20 y INTEGER,.
0b20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0b30: 20 20 20 20 20 20 20 20 20 20 20 20 20 73 74 61 sta
0b40: 74 65 20 54 45 58 54 2c 0a 20 20 20 20 20 20 20 te TEXT,.
0b50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0b60: 20 20 20 20 20 20 20 20 20 20 20 6d 74 5f 76 65 mt_ve
0b70: 72 73 69 6f 6e 20 54 45 58 54 2c 0a 20 20 20 20 rsion TEXT,.
0b80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0b90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 68 65 he
0ba0: 61 72 74 62 65 61 74 20 54 49 4d 45 53 54 41 4d artbeat TIMESTAM
0bb0: 50 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 P,.
0bc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0bd0: 20 20 20 20 20 74 72 61 6e 73 70 6f 72 74 20 54 transport T
0be0: 45 58 54 2c 0a 20 20 20 20 20 20 20 20 20 20 20 EXT,.
0bf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0c00: 20 20 20 20 43 4f 4e 53 54 52 41 49 4e 54 20 73 CONSTRAINT s
0c10: 65 72 76 65 72 73 5f 63 6f 6e 73 74 72 61 69 6e ervers_constrain
0c20: 74 20 55 4e 49 51 55 45 20 28 70 69 64 2c 68 6f t UNIQUE (pid,ho
0c30: 73 74 6e 61 6d 65 2c 70 6f 72 74 29 29 3b 22 29 stname,port));")
0c40: 0a 09 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 .. (sqlite3:exe
0c50: 63 75 74 65 20 6d 64 62 20 22 43 52 45 41 54 45 cute mdb "CREATE
0c60: 20 54 41 42 4c 45 20 49 46 20 4e 4f 54 20 45 58 TABLE IF NOT EX
0c70: 49 53 54 53 20 63 6c 69 65 6e 74 73 20 28 69 64 ISTS clients (id
0c80: 20 49 4e 54 45 47 45 52 20 50 52 49 4d 41 52 59 INTEGER PRIMARY
0c90: 20 4b 45 59 2c 0a 20 20 20 20 20 20 20 20 20 20 KEY,.
0ca0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0cb0: 20 20 20 20 20 20 20 20 73 65 72 76 65 72 5f 69 server_i
0cc0: 64 20 49 4e 54 45 47 45 52 2c 0a 20 20 20 20 20 d INTEGER,.
0cd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ce0: 20 20 20 20 20 20 20 20 20 20 20 20 20 70 69 64 pid
0cf0: 20 49 4e 54 45 47 45 52 2c 0a 20 20 20 20 20 20 INTEGER,.
0d00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d10: 20 20 20 20 20 20 20 20 20 20 20 20 68 6f 73 74 host
0d20: 6e 61 6d 65 20 54 45 58 54 2c 0a 20 20 20 20 20 name TEXT,.
0d30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d40: 20 20 20 20 20 20 20 20 20 20 20 20 20 63 6d 64 cmd
0d50: 6c 69 6e 65 20 54 45 58 54 2c 0a 20 20 20 20 20 line TEXT,.
0d60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d70: 20 20 20 20 20 20 20 20 20 20 20 20 20 6c 6f 67 log
0d80: 69 6e 5f 74 69 6d 65 20 54 49 4d 45 53 54 41 4d in_time TIMESTAM
0d90: 50 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 P,.
0da0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0db0: 20 20 20 20 20 6c 6f 67 6f 75 74 5f 74 69 6d 65 logout_time
0dc0: 20 54 49 4d 45 53 54 41 4d 50 20 44 45 46 41 55 TIMESTAMP DEFAU
0dd0: 4c 54 20 2d 31 2c 0a 20 20 20 20 20 20 20 20 20 LT -1,.
0de0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0df0: 20 20 20 20 20 20 20 43 4f 4e 53 54 52 41 49 4e CONSTRAIN
0e00: 54 20 63 6c 69 65 6e 74 73 5f 63 6f 6e 73 74 72 T clients_constr
0e10: 61 69 6e 74 20 55 4e 49 51 55 45 20 28 70 69 64 aint UNIQUE (pid
0e20: 2c 68 6f 73 74 6e 61 6d 65 29 29 3b 22 29 0a 20 ,hostname));").
0e30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e50: 20 0a 09 20 20 29 29 0a 20 20 20 20 6d 64 62 29 .. )). mdb)
0e60: 29 0a 20 20 20 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d ). .;;=======
0e70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0e80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 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 0a ===============.
0eb0: 3b 3b 20 53 65 72 76 65 72 20 61 6e 64 20 63 6c ;; Server and cl
0ec0: 69 65 6e 74 20 6d 61 6e 61 67 65 6d 65 6e 74 0a ient management.
0ed0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
0ee0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0ef0: 3d 3d 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 0a 0a 3b 3b 20 6d 61 6b ========..;; mak
0f20: 65 2d 76 65 63 74 6f 72 2d 72 65 63 6f 72 64 20 e-vector-record
0f30: 74 61 73 6b 73 20 68 6f 73 74 69 6e 66 6f 20 69 tasks hostinfo i
0f40: 64 20 69 6e 74 65 72 66 61 63 65 20 70 6f 72 74 d interface port
0f50: 20 70 75 62 70 6f 72 74 20 74 72 61 6e 73 70 6f pubport transpo
0f60: 72 74 20 70 69 64 20 68 6f 73 74 6e 61 6d 65 0a rt pid hostname.
0f70: 28 64 65 66 69 6e 65 20 28 74 61 73 6b 73 3a 68 (define (tasks:h
0f80: 6f 73 74 69 6e 66 6f 2d 67 65 74 2d 69 64 20 20 ostinfo-get-id
0f90: 20 20 20 20 20 20 20 20 76 65 63 29 20 20 20 20 vec)
0fa0: 28 76 65 63 74 6f 72 2d 72 65 66 20 20 76 65 63 (vector-ref vec
0fb0: 20 30 29 29 0a 28 64 65 66 69 6e 65 20 28 74 61 0)).(define (ta
0fc0: 73 6b 73 3a 68 6f 73 74 69 6e 66 6f 2d 67 65 74 sks:hostinfo-get
0fd0: 2d 69 6e 74 65 72 66 61 63 65 20 20 20 76 65 63 -interface vec
0fe0: 29 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 ) (vector-ref
0ff0: 20 20 76 65 63 20 31 29 29 0a 28 64 65 66 69 6e vec 1)).(defin
1000: 65 20 28 74 61 73 6b 73 3a 68 6f 73 74 69 6e 66 e (tasks:hostinf
1010: 6f 2d 67 65 74 2d 70 6f 72 74 20 20 20 20 20 20 o-get-port
1020: 20 20 76 65 63 29 20 20 20 20 28 76 65 63 74 6f vec) (vecto
1030: 72 2d 72 65 66 20 20 76 65 63 20 32 29 29 0a 28 r-ref vec 2)).(
1040: 64 65 66 69 6e 65 20 28 74 61 73 6b 73 3a 68 6f define (tasks:ho
1050: 73 74 69 6e 66 6f 2d 67 65 74 2d 70 75 62 70 6f stinfo-get-pubpo
1060: 72 74 20 20 20 20 20 76 65 63 29 20 20 20 20 28 rt vec) (
1070: 76 65 63 74 6f 72 2d 72 65 66 20 20 76 65 63 20 vector-ref vec
1080: 33 29 29 0a 28 64 65 66 69 6e 65 20 28 74 61 73 3)).(define (tas
1090: 6b 73 3a 68 6f 73 74 69 6e 66 6f 2d 67 65 74 2d ks:hostinfo-get-
10a0: 74 72 61 6e 73 70 6f 72 74 20 20 20 76 65 63 29 transport vec)
10b0: 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (vector-ref
10c0: 20 76 65 63 20 34 29 29 0a 28 64 65 66 69 6e 65 vec 4)).(define
10d0: 20 28 74 61 73 6b 73 3a 68 6f 73 74 69 6e 66 6f (tasks:hostinfo
10e0: 2d 67 65 74 2d 70 69 64 20 20 20 20 20 20 20 20 -get-pid
10f0: 20 76 65 63 29 20 20 20 20 28 76 65 63 74 6f 72 vec) (vector
1100: 2d 72 65 66 20 20 76 65 63 20 35 29 29 0a 28 64 -ref vec 5)).(d
1110: 65 66 69 6e 65 20 28 74 61 73 6b 73 3a 68 6f 73 efine (tasks:hos
1120: 74 69 6e 66 6f 2d 67 65 74 2d 68 6f 73 74 6e 61 tinfo-get-hostna
1130: 6d 65 20 20 20 20 76 65 63 29 20 20 20 20 28 76 me vec) (v
1140: 65 63 74 6f 72 2d 72 65 66 20 20 76 65 63 20 36 ector-ref vec 6
1150: 29 29 0a 0a 3b 3b 20 73 74 61 74 65 3a 20 27 6c ))..;; state: 'l
1160: 69 76 65 2c 20 27 73 68 75 74 74 69 6e 67 2d 64 ive, 'shutting-d
1170: 6f 77 6e 2c 20 27 64 65 61 64 0a 28 64 65 66 69 own, 'dead.(defi
1180: 6e 65 20 28 74 61 73 6b 73 3a 73 65 72 76 65 72 ne (tasks:server
1190: 2d 72 65 67 69 73 74 65 72 20 6d 64 62 20 70 69 -register mdb pi
11a0: 64 20 69 6e 74 65 72 66 61 63 65 20 70 6f 72 74 d interface port
11b0: 20 70 72 69 6f 72 69 74 79 20 73 74 61 74 65 20 priority state
11c0: 74 72 61 6e 73 70 6f 72 74 20 23 21 6b 65 79 20 transport #!key
11d0: 28 70 75 62 70 6f 72 74 20 2d 31 29 29 0a 20 20 (pubport -1)).
11e0: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
11f0: 6f 20 31 31 20 22 74 61 73 6b 73 3a 73 65 72 76 o 11 "tasks:serv
1200: 65 72 2d 72 65 67 69 73 74 65 72 20 22 20 70 69 er-register " pi
1210: 64 20 22 20 22 20 69 6e 74 65 72 66 61 63 65 20 d " " interface
1220: 22 20 22 20 70 6f 72 74 20 22 20 22 20 70 72 69 " " port " " pri
1230: 6f 72 69 74 79 20 22 20 22 20 73 74 61 74 65 29 ority " " state)
1240: 0a 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 . (sqlite3:exec
1250: 75 74 65 20 0a 20 20 20 6d 64 62 20 0a 20 20 20 ute . mdb .
1260: 22 49 4e 53 45 52 54 20 4f 52 20 52 45 50 4c 41 "INSERT OR REPLA
1270: 43 45 20 49 4e 54 4f 20 73 65 72 76 65 72 73 20 CE INTO servers
1280: 28 70 69 64 2c 68 6f 73 74 6e 61 6d 65 2c 70 6f (pid,hostname,po
1290: 72 74 2c 70 75 62 70 6f 72 74 2c 73 74 61 72 74 rt,pubport,start
12a0: 5f 74 69 6d 65 2c 70 72 69 6f 72 69 74 79 2c 73 _time,priority,s
12b0: 74 61 74 65 2c 6d 74 5f 76 65 72 73 69 6f 6e 2c tate,mt_version,
12c0: 68 65 61 72 74 62 65 61 74 2c 69 6e 74 65 72 66 heartbeat,interf
12d0: 61 63 65 2c 74 72 61 6e 73 70 6f 72 74 29 0a 20 ace,transport).
12e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12f0: 20 20 20 20 20 20 20 20 20 20 20 20 56 41 4c 55 VALU
1300: 45 53 28 3f 2c 20 20 3f 2c 20 20 20 20 20 20 20 ES(?, ?,
1310: 3f 2c 20 20 20 3f 2c 20 20 73 74 72 66 74 69 6d ?, ?, strftim
1320: 65 28 27 25 73 27 2c 27 6e 6f 77 27 29 2c 20 3f e('%s','now'), ?
1330: 2c 20 3f 2c 20 3f 2c 20 73 74 72 66 74 69 6d 65 , ?, ?, strftime
1340: 28 27 25 73 27 2c 27 6e 6f 77 27 29 2c 3f 2c 3f ('%s','now'),?,?
1350: 29 3b 22 0a 20 20 20 70 69 64 20 28 67 65 74 2d );". pid (get-
1360: 68 6f 73 74 2d 6e 61 6d 65 29 20 70 6f 72 74 20 host-name) port
1370: 70 75 62 70 6f 72 74 20 70 72 69 6f 72 69 74 79 pubport priority
1380: 20 28 63 6f 6e 63 20 73 74 61 74 65 29 20 6d 65 (conc state) me
1390: 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 20 69 gatest-version i
13a0: 6e 74 65 72 66 61 63 65 20 28 63 6f 6e 63 20 74 nterface (conc t
13b0: 72 61 6e 73 70 6f 72 74 29 29 0a 20 20 28 76 65 ransport)). (ve
13c0: 63 74 6f 72 20 0a 20 20 20 28 74 61 73 6b 73 3a ctor . (tasks:
13d0: 73 65 72 76 65 72 2d 67 65 74 2d 73 65 72 76 65 server-get-serve
13e0: 72 2d 69 64 20 6d 64 62 20 28 67 65 74 2d 68 6f r-id mdb (get-ho
13f0: 73 74 2d 6e 61 6d 65 29 20 69 6e 74 65 72 66 61 st-name) interfa
1400: 63 65 20 70 6f 72 74 20 70 69 64 29 0a 20 20 20 ce port pid).
1410: 69 6e 74 65 72 66 61 63 65 0a 20 20 20 70 6f 72 interface. por
1420: 74 0a 20 20 20 70 75 62 70 6f 72 74 0a 20 20 20 t. pubport.
1430: 74 72 61 6e 73 70 6f 72 74 0a 20 20 20 29 29 0a transport. )).
1440: 0a 3b 3b 20 4e 42 2f 2f 20 74 77 6f 20 73 65 72 .;; NB// two ser
1450: 76 65 72 73 20 77 69 74 68 20 73 61 6d 65 20 70 vers with same p
1460: 69 64 20 6f 6e 20 64 69 66 66 65 72 65 6e 74 20 id on different
1470: 68 6f 73 74 73 20 77 69 6c 6c 20 62 65 20 72 65 hosts will be re
1480: 6d 6f 76 65 64 20 66 72 6f 6d 20 74 68 65 20 6c moved from the l
1490: 69 73 74 20 69 66 20 70 69 64 3a 20 69 73 20 75 ist if pid: is u
14a0: 73 65 64 21 0a 28 64 65 66 69 6e 65 20 28 74 61 sed!.(define (ta
14b0: 73 6b 73 3a 73 65 72 76 65 72 2d 64 65 72 65 67 sks:server-dereg
14c0: 69 73 74 65 72 20 6d 64 62 20 68 6f 73 74 6e 61 ister mdb hostna
14d0: 6d 65 20 23 21 6b 65 79 20 28 70 6f 72 74 20 23 me #!key (port #
14e0: 66 29 28 70 69 64 20 23 66 29 28 61 63 74 69 6f f)(pid #f)(actio
14f0: 6e 20 27 6d 61 72 6b 64 65 61 64 29 29 0a 20 20 n 'markdead)).
1500: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
1510: 6f 20 31 31 20 22 73 65 72 76 65 72 2d 64 65 72 o 11 "server-der
1520: 65 67 69 73 74 65 72 20 22 20 68 6f 73 74 6e 61 egister " hostna
1530: 6d 65 20 22 2c 20 70 6f 72 74 20 22 20 70 6f 72 me ", port " por
1540: 74 20 22 2c 20 70 69 64 20 22 20 70 69 64 29 0a t ", pid " pid).
1550: 20 20 28 69 66 20 2a 64 62 2d 77 72 69 74 65 2d (if *db-write-
1560: 61 63 63 65 73 73 2a 0a 20 20 20 20 20 20 28 69 access*. (i
1570: 66 20 70 69 64 0a 09 20 20 28 63 61 73 65 20 61 f pid.. (case a
1580: 63 74 69 6f 6e 0a 09 20 20 20 20 28 28 64 65 6c ction.. ((del
1590: 65 74 65 29 28 73 71 6c 69 74 65 33 3a 65 78 65 ete)(sqlite3:exe
15a0: 63 75 74 65 20 6d 64 62 20 22 44 45 4c 45 54 45 cute mdb "DELETE
15b0: 20 46 52 4f 4d 20 73 65 72 76 65 72 73 20 57 48 FROM servers WH
15c0: 45 52 45 20 70 69 64 3d 3f 3b 22 20 70 69 64 29 ERE pid=?;" pid)
15d0: 29 0a 09 20 20 20 20 28 65 6c 73 65 20 20 20 20 ).. (else
15e0: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
15f0: 20 6d 64 62 20 22 55 50 44 41 54 45 20 73 65 72 mdb "UPDATE ser
1600: 76 65 72 73 20 53 45 54 20 73 74 61 74 65 3d 27 vers SET state='
1610: 64 65 61 64 27 20 57 48 45 52 45 20 70 69 64 3d dead' WHERE pid=
1620: 3f 3b 22 20 70 69 64 29 29 29 0a 09 20 20 28 69 ?;" pid))).. (i
1630: 66 20 70 6f 72 74 0a 09 20 20 20 20 20 20 28 63 f port.. (c
1640: 61 73 65 20 61 63 74 69 6f 6e 0a 09 09 28 28 64 ase action...((d
1650: 65 6c 65 74 65 29 28 73 71 6c 69 74 65 33 3a 65 elete)(sqlite3:e
1660: 78 65 63 75 74 65 20 6d 64 62 20 22 44 45 4c 45 xecute mdb "DELE
1670: 54 45 20 46 52 4f 4d 20 73 65 72 76 65 72 73 20 TE FROM servers
1680: 57 48 45 52 45 20 20 68 6f 73 74 6e 61 6d 65 3d WHERE hostname=
1690: 3f 20 41 4e 44 20 70 6f 72 74 3d 3f 3b 22 20 68 ? AND port=?;" h
16a0: 6f 73 74 6e 61 6d 65 20 70 6f 72 74 29 29 0a 09 ostname port))..
16b0: 09 28 65 6c 73 65 20 20 20 20 28 73 71 6c 69 74 .(else (sqlit
16c0: 65 33 3a 65 78 65 63 75 74 65 20 6d 64 62 20 22 e3:execute mdb "
16d0: 55 50 44 41 54 45 20 73 65 72 76 65 72 73 20 53 UPDATE servers S
16e0: 45 54 20 73 74 61 74 65 3d 27 64 65 61 64 27 20 ET state='dead'
16f0: 57 48 45 52 45 20 68 6f 73 74 6e 61 6d 65 3d 3f WHERE hostname=?
1700: 20 41 4e 44 20 70 6f 72 74 3d 3f 3b 22 20 68 6f AND port=?;" ho
1710: 73 74 6e 61 6d 65 20 70 6f 72 74 29 29 29 0a 09 stname port)))..
1720: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
1730: 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 74 61 73 nt 0 "ERROR: tas
1740: 6b 73 3a 73 65 72 76 65 72 2d 64 65 72 65 67 69 ks:server-deregi
1750: 73 74 65 72 20 63 61 6c 6c 65 64 20 77 69 74 68 ster called with
1760: 20 6e 65 69 74 68 65 72 20 70 69 64 20 6e 6f 72 neither pid nor
1770: 20 70 6f 72 74 20 73 70 65 63 69 66 69 65 64 22 port specified"
1780: 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 )))))..(define (
1790: 74 61 73 6b 73 3a 73 65 72 76 65 72 2d 64 65 72 tasks:server-der
17a0: 65 67 69 73 74 65 72 2d 73 65 6c 66 20 6d 64 62 egister-self mdb
17b0: 20 68 6f 73 74 6e 61 6d 65 29 0a 20 20 28 74 61 hostname). (ta
17c0: 73 6b 73 3a 73 65 72 76 65 72 2d 64 65 72 65 67 sks:server-dereg
17d0: 69 73 74 65 72 20 6d 64 62 20 68 6f 73 74 6e 61 ister mdb hostna
17e0: 6d 65 20 70 69 64 3a 20 28 63 75 72 72 65 6e 74 me pid: (current
17f0: 2d 70 72 6f 63 65 73 73 2d 69 64 29 29 29 0a 0a -process-id)))..
1800: 3b 3b 20 6e 65 65 64 20 61 20 73 69 6d 70 6c 65 ;; need a simple
1810: 20 63 61 6c 6c 20 66 6f 72 20 72 6f 62 75 73 74 call for robust
1820: 6c 79 20 72 65 6d 6f 76 69 6e 67 20 72 65 63 6f ly removing reco
1830: 72 64 73 20 67 69 76 65 6e 20 68 6f 73 74 20 61 rds given host a
1840: 6e 64 20 70 6f 72 74 0a 28 64 65 66 69 6e 65 20 nd port.(define
1850: 28 74 61 73 6b 73 3a 73 65 72 76 65 72 2d 64 65 (tasks:server-de
1860: 6c 65 74 65 20 6d 64 62 20 68 6f 73 74 6e 61 6d lete mdb hostnam
1870: 65 20 70 6f 72 74 29 0a 20 20 28 74 61 73 6b 73 e port). (tasks
1880: 3a 73 65 72 76 65 72 2d 64 65 72 65 67 69 73 74 :server-deregist
1890: 65 72 20 6d 64 62 20 68 6f 73 74 6e 61 6d 65 20 er mdb hostname
18a0: 70 6f 72 74 3a 20 70 6f 72 74 20 61 63 74 69 6f port: port actio
18b0: 6e 3a 20 27 64 65 6c 65 74 65 29 29 0a 0a 28 64 n: 'delete))..(d
18c0: 65 66 69 6e 65 20 28 74 61 73 6b 73 3a 73 65 72 efine (tasks:ser
18d0: 76 65 72 2d 67 65 74 2d 73 65 72 76 65 72 2d 69 ver-get-server-i
18e0: 64 20 6d 64 62 20 68 6f 73 74 6e 61 6d 65 20 69 d mdb hostname i
18f0: 66 61 63 65 20 70 6f 72 74 20 70 69 64 29 0a 20 face port pid).
1900: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
1910: 66 6f 20 31 32 20 22 74 61 73 6b 73 3a 73 65 72 fo 12 "tasks:ser
1920: 76 65 72 2d 67 65 74 2d 73 65 72 76 65 72 2d 69 ver-get-server-i
1930: 64 20 22 20 6d 64 62 20 22 20 22 20 68 6f 73 74 d " mdb " " host
1940: 6e 61 6d 65 20 22 20 22 20 69 66 61 63 65 20 22 name " " iface "
1950: 20 22 20 70 6f 72 74 20 22 20 22 20 70 69 64 29 " port " " pid)
1960: 0a 20 20 28 6c 65 74 20 28 28 72 65 73 20 23 66 . (let ((res #f
1970: 29 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a )). (sqlite3:
1980: 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 20 20 20 for-each-row.
1990: 20 20 28 6c 61 6d 62 64 61 20 28 69 64 29 0a 20 (lambda (id).
19a0: 20 20 20 20 20 20 28 73 65 74 21 20 72 65 73 20 (set! res
19b0: 69 64 29 29 0a 20 20 20 20 20 6d 64 62 0a 20 20 id)). mdb.
19c0: 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 28 (cond. (
19d0: 28 61 6e 64 20 68 6f 73 74 6e 61 6d 65 20 20 70 (and hostname p
19e0: 69 64 29 20 20 22 53 45 4c 45 43 54 20 69 64 20 id) "SELECT id
19f0: 46 52 4f 4d 20 73 65 72 76 65 72 73 20 57 48 45 FROM servers WHE
1a00: 52 45 20 68 6f 73 74 6e 61 6d 65 3d 3f 20 20 41 RE hostname=? A
1a10: 4e 44 20 70 69 64 3d 3f 3b 22 29 0a 20 20 20 20 ND pid=?;").
1a20: 20 20 28 28 61 6e 64 20 69 66 61 63 65 20 20 20 ((and iface
1a30: 20 20 70 6f 72 74 29 20 22 53 45 4c 45 43 54 20 port) "SELECT
1a40: 69 64 20 46 52 4f 4d 20 73 65 72 76 65 72 73 20 id FROM servers
1a50: 57 48 45 52 45 20 69 6e 74 65 72 66 61 63 65 3d WHERE interface=
1a60: 3f 20 41 4e 44 20 70 6f 72 74 3d 3f 3b 22 29 0a ? AND port=?;").
1a70: 20 20 20 20 20 20 28 28 61 6e 64 20 68 6f 73 74 ((and host
1a80: 6e 61 6d 65 20 20 70 6f 72 74 29 20 22 53 45 4c name port) "SEL
1a90: 45 43 54 20 69 64 20 46 52 4f 4d 20 73 65 72 76 ECT id FROM serv
1aa0: 65 72 73 20 57 48 45 52 45 20 68 6f 73 74 6e 61 ers WHERE hostna
1ab0: 6d 65 3d 3f 20 20 41 4e 44 20 70 6f 72 74 3d 3f me=? AND port=?
1ac0: 3b 22 29 0a 20 20 20 20 20 20 28 65 6c 73 65 0a ;"). (else.
1ad0: 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 20 (begin..
1ae0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
1af0: 45 52 52 4f 52 3a 20 74 61 73 6b 73 3a 73 65 72 ERROR: tasks:ser
1b00: 76 65 72 2d 67 65 74 2d 73 65 72 76 65 72 2d 69 ver-get-server-i
1b10: 64 20 6e 65 65 64 73 20 28 68 6f 73 74 6e 61 6d d needs (hostnam
1b20: 65 20 61 6e 64 20 70 69 64 29 20 4f 52 20 28 69 e and pid) OR (i
1b30: 66 61 63 65 20 61 6e 64 20 70 6f 72 74 29 20 4f face and port) O
1b40: 52 20 28 68 6f 73 74 6e 61 6d 65 20 61 6e 64 20 R (hostname and
1b50: 70 6f 72 74 29 22 29 0a 09 20 22 53 45 4c 45 43 port)").. "SELEC
1b60: 54 20 69 64 20 46 52 4f 4d 20 73 65 72 76 65 72 T id FROM server
1b70: 73 20 57 48 45 52 45 20 70 69 64 3d 2d 39 39 39 s WHERE pid=-999
1b80: 3b 22 29 29 29 0a 20 20 20 20 20 28 69 66 20 68 ;"))). (if h
1b90: 6f 73 74 6e 61 6d 65 20 68 6f 73 74 6e 61 6d 65 ostname hostname
1ba0: 20 69 66 61 63 65 29 28 69 66 20 70 69 64 20 70 iface)(if pid p
1bb0: 69 64 20 70 6f 72 74 29 29 0a 20 20 20 20 72 65 id port)). re
1bc0: 73 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 61 s))..(define (ta
1bd0: 73 6b 73 3a 73 65 72 76 65 72 2d 75 70 64 61 74 sks:server-updat
1be0: 65 2d 68 65 61 72 74 62 65 61 74 20 6d 64 62 20 e-heartbeat mdb
1bf0: 73 65 72 76 65 72 2d 69 64 29 0a 20 20 28 64 65 server-id). (de
1c00: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 bug:print-info 0
1c10: 20 22 48 65 61 72 74 20 62 65 61 74 20 75 70 64 "Heart beat upd
1c20: 61 74 65 20 6f 66 20 73 65 72 76 65 72 20 69 64 ate of server id
1c30: 3d 22 20 73 65 72 76 65 72 2d 69 64 29 0a 20 20 =" server-id).
1c40: 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f (handle-exceptio
1c50: 6e 73 0a 20 20 20 65 78 6e 0a 20 20 20 28 62 65 ns. exn. (be
1c60: 67 69 6e 0a 20 20 20 20 20 28 64 65 62 75 67 3a gin. (debug:
1c70: 70 72 69 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 print 0 "WARNING
1c80: 3a 20 70 72 6f 62 61 62 6c 65 20 74 69 6d 65 6f : probable timeo
1c90: 75 74 20 6f 6e 20 6d 6f 6e 69 74 6f 72 2e 64 62 ut on monitor.db
1ca0: 20 61 63 63 65 73 73 22 29 0a 20 20 20 20 20 28 access"). (
1cb0: 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 31 29 thread-sleep! 1)
1cc0: 0a 20 20 20 20 20 28 74 61 73 6b 73 3a 73 65 72 . (tasks:ser
1cd0: 76 65 72 2d 75 70 64 61 74 65 2d 68 65 61 72 74 ver-update-heart
1ce0: 62 65 61 74 20 6d 64 62 20 73 65 72 76 65 72 2d beat mdb server-
1cf0: 69 64 29 29 0a 20 20 20 28 73 71 6c 69 74 65 33 id)). (sqlite3
1d00: 3a 65 78 65 63 75 74 65 20 6d 64 62 20 22 55 50 :execute mdb "UP
1d10: 44 41 54 45 20 73 65 72 76 65 72 73 20 53 45 54 DATE servers SET
1d20: 20 68 65 61 72 74 62 65 61 74 3d 73 74 72 66 74 heartbeat=strft
1d30: 69 6d 65 28 27 25 73 27 2c 27 6e 6f 77 27 29 20 ime('%s','now')
1d40: 57 48 45 52 45 20 69 64 3d 3f 3b 22 20 73 65 72 WHERE id=?;" ser
1d50: 76 65 72 2d 69 64 29 29 29 0a 0a 3b 3b 20 61 6c ver-id)))..;; al
1d60: 69 76 65 20 73 65 72 76 65 72 73 20 6b 65 65 70 ive servers keep
1d70: 20 74 68 65 20 68 65 61 72 74 62 65 61 74 20 66 the heartbeat f
1d80: 69 65 6c 64 20 75 70 74 6f 20 64 61 74 65 20 77 ield upto date w
1d90: 69 74 68 20 73 65 63 6f 6e 64 73 20 65 76 65 72 ith seconds ever
1da0: 79 20 36 20 6f 72 20 73 6f 20 73 65 63 6f 6e 64 y 6 or so second
1db0: 73 0a 28 64 65 66 69 6e 65 20 28 74 61 73 6b 73 s.(define (tasks
1dc0: 3a 73 65 72 76 65 72 2d 61 6c 69 76 65 3f 20 6d :server-alive? m
1dd0: 64 62 20 73 65 72 76 65 72 2d 69 64 20 23 21 6b db server-id #!k
1de0: 65 79 20 28 69 66 61 63 65 20 23 66 29 28 68 6f ey (iface #f)(ho
1df0: 73 74 6e 61 6d 65 20 23 66 29 28 70 6f 72 74 20 stname #f)(port
1e00: 23 66 29 28 70 69 64 20 23 66 29 29 0a 20 20 28 #f)(pid #f)). (
1e10: 6c 65 74 2a 20 28 28 73 65 72 76 65 72 2d 69 64 let* ((server-id
1e20: 20 20 28 69 66 20 73 65 72 76 65 72 2d 69 64 20 (if server-id
1e30: 0a 09 09 09 20 73 65 72 76 65 72 2d 69 64 0a 09 .... server-id..
1e40: 09 09 20 28 74 61 73 6b 73 3a 73 65 72 76 65 72 .. (tasks:server
1e50: 2d 67 65 74 2d 73 65 72 76 65 72 2d 69 64 20 6d -get-server-id m
1e60: 64 62 20 68 6f 73 74 6e 61 6d 65 20 69 66 61 63 db hostname ifac
1e70: 65 20 70 6f 72 74 20 70 69 64 29 29 29 0a 09 20 e port pid)))..
1e80: 28 68 65 61 72 74 62 65 61 74 2d 64 65 6c 74 61 (heartbeat-delta
1e90: 20 39 39 65 39 29 29 0a 20 20 20 20 28 73 71 6c 99e9)). (sql
1ea0: 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f ite3:for-each-ro
1eb0: 77 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 w. (lambda (
1ec0: 64 65 6c 74 61 29 0a 20 20 20 20 20 20 20 28 73 delta). (s
1ed0: 65 74 21 20 68 65 61 72 74 62 65 61 74 2d 64 65 et! heartbeat-de
1ee0: 6c 74 61 20 64 65 6c 74 61 29 29 0a 20 20 20 20 lta delta)).
1ef0: 20 6d 64 62 20 22 53 45 4c 45 43 54 20 73 74 72 mdb "SELECT str
1f00: 66 74 69 6d 65 28 27 25 73 27 2c 27 6e 6f 77 27 ftime('%s','now'
1f10: 29 2d 68 65 61 72 74 62 65 61 74 20 46 52 4f 4d )-heartbeat FROM
1f20: 20 73 65 72 76 65 72 73 20 57 48 45 52 45 20 69 servers WHERE i
1f30: 64 3d 3f 3b 22 20 73 65 72 76 65 72 2d 69 64 29 d=?;" server-id)
1f40: 0a 20 20 20 20 28 3c 20 68 65 61 72 74 62 65 61 . (< heartbea
1f50: 74 2d 64 65 6c 74 61 20 31 30 29 29 29 0a 0a 28 t-delta 10)))..(
1f60: 64 65 66 69 6e 65 20 28 74 61 73 6b 73 3a 63 6c define (tasks:cl
1f70: 69 65 6e 74 2d 72 65 67 69 73 74 65 72 20 6d 64 ient-register md
1f80: 62 20 70 69 64 20 68 6f 73 74 6e 61 6d 65 20 63 b pid hostname c
1f90: 6d 64 6c 69 6e 65 29 0a 20 20 28 73 71 6c 69 74 mdline). (sqlit
1fa0: 65 33 3a 65 78 65 63 75 74 65 0a 20 20 20 6d 64 e3:execute. md
1fb0: 62 0a 20 20 20 22 49 4e 53 45 52 54 20 4f 52 20 b. "INSERT OR
1fc0: 52 45 50 4c 41 43 45 20 49 4e 54 4f 20 63 6c 69 REPLACE INTO cli
1fd0: 65 6e 74 73 20 28 73 65 72 76 65 72 5f 69 64 2c ents (server_id,
1fe0: 70 69 64 2c 68 6f 73 74 6e 61 6d 65 2c 63 6d 64 pid,hostname,cmd
1ff0: 6c 69 6e 65 2c 6c 6f 67 69 6e 5f 74 69 6d 65 29 line,login_time)
2000: 20 56 41 4c 55 45 53 28 3f 2c 3f 2c 3f 2c 3f 2c VALUES(?,?,?,?,
2010: 73 74 72 66 74 69 6d 65 28 27 25 73 27 2c 27 6e strftime('%s','n
2020: 6f 77 27 29 29 3b 22 29 0a 20 20 28 74 61 73 6b ow'));"). (task
2030: 73 3a 73 65 72 76 65 72 2d 67 65 74 2d 73 65 72 s:server-get-ser
2040: 76 65 72 2d 69 64 20 6d 64 62 20 68 6f 73 74 6e ver-id mdb hostn
2050: 61 6d 65 20 23 66 20 23 66 20 70 69 64 29 0a 20 ame #f #f pid).
2060: 20 70 69 64 20 68 6f 73 74 6e 61 6d 65 20 63 6d pid hostname cm
2070: 64 6c 69 6e 65 29 0a 0a 28 64 65 66 69 6e 65 20 dline)..(define
2080: 28 74 61 73 6b 73 3a 63 6c 69 65 6e 74 2d 6c 6f (tasks:client-lo
2090: 67 6f 75 74 20 6d 64 62 20 70 69 64 20 68 6f 73 gout mdb pid hos
20a0: 74 6e 61 6d 65 20 63 6d 64 6c 69 6e 65 29 0a 20 tname cmdline).
20b0: 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 (sqlite3:execut
20c0: 65 0a 20 20 20 6d 64 62 0a 20 20 20 22 55 50 44 e. mdb. "UPD
20d0: 41 54 45 20 63 6c 69 65 6e 74 73 20 53 45 54 20 ATE clients SET
20e0: 6c 6f 67 6f 75 74 5f 74 69 6d 65 3d 73 74 72 66 logout_time=strf
20f0: 74 69 6d 65 28 27 25 73 27 2c 27 6e 6f 77 27 29 time('%s','now')
2100: 20 57 48 45 52 45 20 70 69 64 3d 3f 20 41 4e 44 WHERE pid=? AND
2110: 20 68 6f 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 hostname=? AND
2120: 63 6d 64 6c 69 6e 65 3d 3f 3b 22 0a 20 20 20 70 cmdline=?;". p
2130: 69 64 20 68 6f 73 74 6e 61 6d 65 20 63 6d 64 6c id hostname cmdl
2140: 69 6e 65 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 ine))..(define (
2150: 74 61 73 6b 73 3a 67 65 74 2d 6c 6f 67 67 65 64 tasks:get-logged
2160: 2d 69 6e 2d 63 6c 69 65 6e 74 73 20 6d 64 62 20 -in-clients mdb
2170: 73 65 72 76 65 72 2d 69 64 29 0a 20 20 28 6c 65 server-id). (le
2180: 74 20 28 28 72 65 73 20 27 28 29 29 29 0a 20 20 t ((res '())).
2190: 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 (sqlite3:for-e
21a0: 61 63 68 2d 72 6f 77 20 0a 20 20 20 20 20 28 6c ach-row . (l
21b0: 61 6d 62 64 61 20 28 69 64 20 73 65 72 76 65 72 ambda (id server
21c0: 2d 69 64 20 70 69 64 20 68 6f 73 74 6e 61 6d 65 -id pid hostname
21d0: 20 63 6d 64 6c 69 6e 65 20 6c 6f 67 69 6e 2d 74 cmdline login-t
21e0: 69 6d 65 20 6c 6f 67 6f 75 74 2d 74 69 6d 65 29 ime logout-time)
21f0: 0a 20 20 20 20 20 20 20 28 73 65 74 21 20 72 65 . (set! re
2200: 73 20 28 63 6f 6e 73 20 28 76 65 63 74 6f 72 20 s (cons (vector
2210: 69 64 20 73 65 72 76 65 72 2d 69 64 20 70 69 64 id server-id pid
2220: 20 68 6f 73 74 6e 61 6d 65 20 63 6d 64 6c 69 6e hostname cmdlin
2230: 65 20 6c 6f 67 69 6e 2d 74 69 6d 65 20 6c 6f 75 e login-time lou
2240: 67 6f 75 74 2d 74 69 6d 65 29 20 72 65 73 29 29 gout-time) res))
2250: 29 0a 20 20 20 20 20 6d 64 62 0a 20 20 20 20 20 ). mdb.
2260: 22 53 45 4c 45 43 54 20 69 64 2c 73 65 72 76 65 "SELECT id,serve
2270: 72 5f 69 64 2c 70 69 64 2c 68 6f 73 74 6e 61 6d r_id,pid,hostnam
2280: 65 2c 63 6d 64 6c 69 6e 65 2c 6c 6f 67 69 6e 5f e,cmdline,login_
2290: 74 69 6d 65 2c 6c 6f 67 6f 75 74 5f 74 69 6d 65 time,logout_time
22a0: 20 46 52 4f 4d 20 63 6c 69 65 6e 74 73 20 57 48 FROM clients WH
22b0: 45 52 45 20 73 65 72 76 65 72 5f 69 64 3d 3f 3b ERE server_id=?;
22c0: 22 0a 20 20 20 20 20 73 65 72 76 65 72 2d 69 64 ". server-id
22d0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 61 )))..(define (ta
22e0: 73 6b 73 3a 68 61 76 65 2d 63 6c 69 65 6e 74 73 sks:have-clients
22f0: 3f 20 6d 64 62 20 73 65 72 76 65 72 2d 69 64 29 ? mdb server-id)
2300: 0a 20 20 28 6e 75 6c 6c 3f 20 28 74 61 73 6b 73 . (null? (tasks
2310: 3a 67 65 74 2d 6c 6f 67 67 65 64 2d 69 6e 2d 63 :get-logged-in-c
2320: 6c 69 65 6e 74 73 20 6d 64 62 20 73 65 72 76 65 lients mdb serve
2330: 72 2d 69 64 29 29 29 0a 0a 3b 3b 20 70 69 6e 67 r-id)))..;; ping
2340: 20 65 61 63 68 20 73 65 72 76 65 72 20 69 6e 20 each server in
2350: 74 68 65 20 64 62 20 61 6e 64 20 72 65 74 75 72 the db and retur
2360: 6e 20 66 69 72 73 74 20 66 6f 75 6e 64 20 74 68 n first found th
2370: 61 74 20 72 65 73 70 6f 6e 64 73 2e 20 0a 3b 3b at responds. .;;
2380: 20 72 65 6d 6f 76 65 20 61 6e 79 20 6f 74 68 65 remove any othe
2390: 72 73 2e 20 77 69 6c 6c 20 6e 6f 74 20 6e 65 63 rs. will not nec
23a0: 65 73 73 61 72 69 6c 79 20 72 65 6d 6f 76 65 20 essarily remove
23b0: 61 6c 6c 21 0a 28 64 65 66 69 6e 65 20 28 74 61 all!.(define (ta
23c0: 73 6b 73 3a 67 65 74 2d 62 65 73 74 2d 73 65 72 sks:get-best-ser
23d0: 76 65 72 20 6d 64 62 29 0a 20 20 28 6c 65 74 20 ver mdb). (let
23e0: 28 28 72 65 73 20 27 28 29 29 0a 09 28 62 65 73 ((res '())..(bes
23f0: 74 20 23 66 29 29 0a 20 20 20 20 28 73 71 6c 69 t #f)). (sqli
2400: 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 te3:for-each-row
2410: 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 69 . (lambda (i
2420: 64 20 69 6e 74 65 72 66 61 63 65 20 70 6f 72 74 d interface port
2430: 20 70 75 62 70 6f 72 74 20 74 72 61 6e 73 70 6f pubport transpo
2440: 72 74 20 70 69 64 20 68 6f 73 74 6e 61 6d 65 29 rt pid hostname)
2450: 0a 20 20 20 20 20 20 20 28 73 65 74 21 20 72 65 . (set! re
2460: 73 20 28 63 6f 6e 73 20 28 76 65 63 74 6f 72 20 s (cons (vector
2470: 69 64 20 69 6e 74 65 72 66 61 63 65 20 70 6f 72 id interface por
2480: 74 20 70 75 62 70 6f 72 74 20 74 72 61 6e 73 70 t pubport transp
2490: 6f 72 74 20 70 69 64 20 68 6f 73 74 6e 61 6d 65 ort pid hostname
24a0: 29 20 72 65 73 29 29 0a 20 20 20 20 20 20 20 3b ) res)). ;
24b0: 3b 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e ;(debug:print-in
24c0: 66 6f 20 32 20 22 46 6f 75 6e 64 20 65 78 69 73 fo 2 "Found exis
24d0: 74 69 6e 67 20 73 65 72 76 65 72 20 22 20 68 6f ting server " ho
24e0: 73 74 6e 61 6d 65 20 22 3a 22 20 70 6f 72 74 20 stname ":" port
24f0: 22 20 72 65 67 69 73 74 65 72 65 64 20 69 6e 20 " registered in
2500: 64 62 22 29 29 0a 20 20 20 20 20 20 20 29 0a 20 db")). ).
2510: 20 20 20 20 6d 64 62 0a 20 20 20 20 20 0a 20 20 mdb. .
2520: 20 20 20 22 53 45 4c 45 43 54 20 69 64 2c 69 6e "SELECT id,in
2530: 74 65 72 66 61 63 65 2c 70 6f 72 74 2c 70 75 62 terface,port,pub
2540: 70 6f 72 74 2c 74 72 61 6e 73 70 6f 72 74 2c 70 port,transport,p
2550: 69 64 2c 68 6f 73 74 6e 61 6d 65 20 46 52 4f 4d id,hostname FROM
2560: 20 73 65 72 76 65 72 73 0a 20 20 20 20 20 20 20 servers.
2570: 20 20 20 57 48 45 52 45 20 73 74 72 66 74 69 6d WHERE strftim
2580: 65 28 27 25 73 27 2c 27 6e 6f 77 27 29 2d 68 65 e('%s','now')-he
2590: 61 72 74 62 65 61 74 20 3c 20 31 30 20 0a 20 20 artbeat < 10 .
25a0: 20 20 20 20 20 20 20 20 41 4e 44 20 6d 74 5f 76 AND mt_v
25b0: 65 72 73 69 6f 6e 3d 3f 20 4f 52 44 45 52 20 42 ersion=? ORDER B
25c0: 59 20 73 74 61 72 74 5f 74 69 6d 65 20 44 45 53 Y start_time DES
25d0: 43 20 4c 49 4d 49 54 20 31 3b 22 20 6d 65 67 61 C LIMIT 1;" mega
25e0: 74 65 73 74 2d 76 65 72 73 69 6f 6e 29 0a 20 20 test-version).
25f0: 20 20 3b 3b 20 66 6f 72 20 6e 6f 77 20 77 65 20 ;; for now we
2600: 61 72 65 20 6b 65 65 70 69 6e 67 20 6f 6e 6c 79 are keeping only
2610: 20 6f 6e 65 20 73 65 72 76 65 72 20 72 65 67 69 one server regi
2620: 73 74 65 72 65 64 20 69 6e 20 74 68 65 20 64 62 stered in the db
2630: 2c 20 72 65 74 75 72 6e 20 23 66 20 6f 72 20 66 , return #f or f
2640: 69 72 73 74 20 73 65 72 76 65 72 20 66 6f 75 6e irst server foun
2650: 64 0a 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f d. (if (null?
2660: 20 72 65 73 29 20 23 66 20 28 63 61 72 20 72 65 res) #f (car re
2670: 73 29 29 29 29 0a 0a 3b 3b 20 42 55 47 3a 20 54 s))))..;; BUG: T
2680: 68 69 73 20 6c 6f 67 69 63 20 69 73 20 70 72 6f his logic is pro
2690: 62 61 62 6c 79 20 6e 65 65 64 65 64 20 75 6e 6c bably needed unl
26a0: 65 73 73 20 6d 65 74 68 6f 64 6f 6c 6f 67 79 20 ess methodology
26b0: 63 68 61 6e 67 65 73 20 63 6f 6d 70 6c 65 74 65 changes complete
26c0: 6c 79 2e 2e 2e 0a 3b 3b 0a 3b 3b 20 20 20 20 20 ly....;;.;;
26d0: 28 69 66 20 28 6e 75 6c 6c 3f 20 72 65 73 29 20 (if (null? res)
26e0: 23 66 0a 3b 3b 20 09 28 6c 65 74 20 6c 6f 6f 70 #f.;; .(let loop
26f0: 20 28 28 68 65 64 20 28 63 61 72 20 72 65 73 29 ((hed (car res)
2700: 29 0a 3b 3b 20 09 09 20 20 20 28 74 61 6c 20 28 ).;; .. (tal (
2710: 63 64 72 20 72 65 73 29 29 29 0a 3b 3b 20 09 20 cdr res))).;; .
2720: 20 3b 3b 20 28 70 72 69 6e 74 20 22 68 65 64 3d ;; (print "hed=
2730: 22 20 68 65 64 20 22 2c 20 74 61 6c 3d 22 20 74 " hed ", tal=" t
2740: 61 6c 29 0a 3b 3b 20 09 20 20 28 6c 65 74 2a 20 al).;; . (let*
2750: 28 28 68 6f 73 74 20 20 20 20 20 28 6c 69 73 74 ((host (list
2760: 2d 72 65 66 20 68 65 64 20 30 29 29 0a 3b 3b 20 -ref hed 0)).;;
2770: 09 09 20 28 69 66 61 63 65 20 20 20 20 28 6c 69 .. (iface (li
2780: 73 74 2d 72 65 66 20 68 65 64 20 31 29 29 0a 3b st-ref hed 1)).;
2790: 3b 20 09 09 20 28 70 6f 72 74 20 20 20 20 20 28 ; .. (port (
27a0: 6c 69 73 74 2d 72 65 66 20 68 65 64 20 32 29 29 list-ref hed 2))
27b0: 0a 3b 3b 20 09 09 20 28 70 69 64 20 20 20 20 20 .;; .. (pid
27c0: 20 28 6c 69 73 74 2d 72 65 66 20 68 65 64 20 34 (list-ref hed 4
27d0: 29 29 0a 3b 3b 20 09 09 20 28 61 6c 69 76 65 20 )).;; .. (alive
27e0: 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f (open-run-clo
27f0: 73 65 20 74 61 73 6b 73 3a 73 65 72 76 65 72 2d se tasks:server-
2800: 61 6c 69 76 65 3f 20 74 61 73 6b 73 3a 6f 70 65 alive? tasks:ope
2810: 6e 2d 64 62 20 23 66 20 68 6f 73 74 6e 61 6d 65 n-db #f hostname
2820: 3a 20 68 6f 73 74 20 70 6f 72 74 3a 20 70 6f 72 : host port: por
2830: 74 29 29 29 0a 3b 3b 20 09 20 20 20 20 28 69 66 t))).;; . (if
2840: 20 61 6c 69 76 65 0a 3b 3b 20 09 09 28 62 65 67 alive.;; ..(beg
2850: 69 6e 0a 3b 3b 20 09 09 20 20 28 64 65 62 75 67 in.;; .. (debug
2860: 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 32 20 22 46 :print-info 2 "F
2870: 6f 75 6e 64 20 61 6e 20 65 78 69 73 74 69 6e 67 ound an existing
2880: 2c 20 61 6c 69 76 65 2c 20 73 65 72 76 65 72 20 , alive, server
2890: 22 20 68 6f 73 74 20 22 2c 20 22 20 70 6f 72 74 " host ", " port
28a0: 20 22 2e 22 29 0a 3b 3b 20 09 09 20 20 28 6c 69 ".").;; .. (li
28b0: 73 74 20 68 6f 73 74 20 69 66 61 63 65 20 70 6f st host iface po
28c0: 72 74 29 29 0a 3b 3b 20 09 09 28 62 65 67 69 6e rt)).;; ..(begin
28d0: 0a 3b 3b 20 09 09 20 20 28 64 65 62 75 67 3a 70 .;; .. (debug:p
28e0: 72 69 6e 74 2d 69 6e 66 6f 20 31 20 22 4d 61 72 rint-info 1 "Mar
28f0: 6b 69 6e 67 20 22 20 68 6f 73 74 20 22 3a 22 20 king " host ":"
2900: 70 6f 72 74 20 22 20 61 73 20 64 65 61 64 20 69 port " as dead i
2910: 6e 20 73 65 72 76 65 72 20 72 65 67 69 73 74 72 n server registr
2920: 79 2e 22 29 0a 3b 3b 20 09 09 20 20 28 69 66 20 y.").;; .. (if
2930: 70 6f 72 74 0a 3b 3b 20 09 09 20 20 20 20 20 20 port.;; ..
2940: 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 (open-run-close
2950: 74 61 73 6b 73 3a 73 65 72 76 65 72 2d 64 65 72 tasks:server-der
2960: 65 67 69 73 74 65 72 20 74 61 73 6b 73 3a 6f 70 egister tasks:op
2970: 65 6e 2d 64 62 20 68 6f 73 74 20 70 6f 72 74 3a en-db host port:
2980: 20 70 6f 72 74 29 0a 3b 3b 20 09 09 20 20 20 20 port).;; ..
2990: 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 (open-run-clos
29a0: 65 20 74 61 73 6b 73 3a 73 65 72 76 65 72 2d 64 e tasks:server-d
29b0: 65 72 65 67 69 73 74 65 72 20 74 61 73 6b 73 3a eregister tasks:
29c0: 6f 70 65 6e 2d 64 62 20 68 6f 73 74 20 70 69 64 open-db host pid
29d0: 3a 20 20 70 69 64 29 29 0a 3b 3b 20 09 09 20 20 : pid)).;; ..
29e0: 28 69 66 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 0a (if (null? tal).
29f0: 3b 3b 20 09 09 20 20 20 20 20 20 23 66 0a 3b 3b ;; .. #f.;;
2a00: 20 09 09 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 .. (loop (
2a10: 63 61 72 20 74 61 6c 29 28 63 64 72 20 74 61 6c car tal)(cdr tal
2a20: 29 29 29 29 29 29 29 29 29 29 0a 0a 28 64 65 66 ))))))))))..(def
2a30: 69 6e 65 20 28 74 61 73 6b 73 3a 72 65 6d 6f 76 ine (tasks:remov
2a40: 65 2d 73 65 72 76 65 72 2d 72 65 63 6f 72 64 73 e-server-records
2a50: 20 6d 64 62 29 0a 20 20 28 73 71 6c 69 74 65 33 mdb). (sqlite3
2a60: 3a 65 78 65 63 75 74 65 20 6d 64 62 20 22 44 45 :execute mdb "DE
2a70: 4c 45 54 45 20 46 52 4f 4d 20 73 65 72 76 65 72 LETE FROM server
2a80: 73 3b 22 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 s;"))..(define (
2a90: 74 61 73 6b 73 3a 6d 61 72 6b 2d 73 65 72 76 65 tasks:mark-serve
2aa0: 72 20 68 6f 73 74 6e 61 6d 65 20 70 6f 72 74 20 r hostname port
2ab0: 70 69 64 20 73 74 61 74 65 20 74 72 61 6e 73 70 pid state transp
2ac0: 6f 72 74 29 0a 20 20 28 69 66 20 70 6f 72 74 0a ort). (if port.
2ad0: 20 20 20 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d (open-run-
2ae0: 63 6c 6f 73 65 20 74 61 73 6b 73 3a 73 65 72 76 close tasks:serv
2af0: 65 72 2d 64 65 72 65 67 69 73 74 65 72 20 74 61 er-deregister ta
2b00: 73 6b 73 3a 6f 70 65 6e 2d 64 62 20 68 6f 73 74 sks:open-db host
2b10: 6e 61 6d 65 20 70 6f 72 74 3a 20 70 6f 72 74 29 name port: port)
2b20: 0a 20 20 20 20 20 20 28 6f 70 65 6e 2d 72 75 6e . (open-run
2b30: 2d 63 6c 6f 73 65 20 74 61 73 6b 73 3a 73 65 72 -close tasks:ser
2b40: 76 65 72 2d 64 65 72 65 67 69 73 74 65 72 20 74 ver-deregister t
2b50: 61 73 6b 73 3a 6f 70 65 6e 2d 64 62 20 68 6f 73 asks:open-db hos
2b60: 74 6e 61 6d 65 20 70 69 64 3a 20 20 70 69 64 29 tname pid: pid)
2b70: 29 29 0a 0a 0a 28 64 65 66 69 6e 65 20 28 74 61 ))...(define (ta
2b80: 73 6b 73 3a 6b 69 6c 6c 2d 73 65 72 76 65 72 20 sks:kill-server
2b90: 73 74 61 74 75 73 20 68 6f 73 74 6e 61 6d 65 20 status hostname
2ba0: 70 6f 72 74 20 70 69 64 20 74 72 61 6e 73 70 6f port pid transpo
2bb0: 72 74 29 0a 20 20 28 64 65 62 75 67 3a 70 72 69 rt). (debug:pri
2bc0: 6e 74 2d 69 6e 66 6f 20 31 20 22 52 65 6d 6f 76 nt-info 1 "Remov
2bd0: 69 6e 67 20 64 65 66 75 6e 63 74 20 73 65 72 76 ing defunct serv
2be0: 65 72 20 72 65 63 6f 72 64 20 66 6f 72 20 22 20 er record for "
2bf0: 68 6f 73 74 6e 61 6d 65 20 22 3a 22 20 70 6f 72 hostname ":" por
2c00: 74 29 0a 20 20 28 69 66 20 70 6f 72 74 0a 20 20 t). (if port.
2c10: 20 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c (open-run-cl
2c20: 6f 73 65 20 74 61 73 6b 73 3a 73 65 72 76 65 72 ose tasks:server
2c30: 2d 64 65 72 65 67 69 73 74 65 72 20 74 61 73 6b -deregister task
2c40: 73 3a 6f 70 65 6e 2d 64 62 20 68 6f 73 74 6e 61 s:open-db hostna
2c50: 6d 65 20 70 6f 72 74 3a 20 70 6f 72 74 29 0a 20 me port: port).
2c60: 20 20 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 (open-run-c
2c70: 6c 6f 73 65 20 74 61 73 6b 73 3a 73 65 72 76 65 lose tasks:serve
2c80: 72 2d 64 65 72 65 67 69 73 74 65 72 20 74 61 73 r-deregister tas
2c90: 6b 73 3a 6f 70 65 6e 2d 64 62 20 68 6f 73 74 6e ks:open-db hostn
2ca0: 61 6d 65 20 70 69 64 3a 20 20 70 69 64 29 29 0a ame pid: pid)).
2cb0: 20 20 28 69 66 20 73 74 61 74 75 73 20 3b 3b 20 (if status ;;
2cc0: 23 74 20 6d 65 61 6e 73 20 61 6c 69 76 65 0a 20 #t means alive.
2cd0: 20 20 20 20 20 28 62 65 67 69 6e 0a 09 28 69 66 (begin..(if
2ce0: 20 28 65 71 75 61 6c 3f 20 68 6f 73 74 6e 61 6d (equal? hostnam
2cf0: 65 20 28 67 65 74 2d 68 6f 73 74 2d 6e 61 6d 65 e (get-host-name
2d00: 29 29 0a 09 20 20 20 20 28 68 61 6e 64 6c 65 2d )).. (handle-
2d10: 65 78 63 65 70 74 69 6f 6e 73 0a 09 20 20 20 20 exceptions..
2d20: 20 65 78 6e 0a 09 20 20 20 20 20 28 64 65 62 75 exn.. (debu
2d30: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 22 g:print-info 0 "
2d40: 73 65 72 76 65 72 20 6d 61 79 20 6f 72 20 6d 61 server may or ma
2d50: 79 20 6e 6f 74 20 62 65 20 64 65 61 64 2c 20 63 y not be dead, c
2d60: 68 65 63 6b 20 66 6f 72 20 6d 65 67 61 74 65 73 heck for megates
2d70: 74 20 2d 73 65 72 76 65 72 20 72 75 6e 6e 69 6e t -server runnin
2d80: 67 20 61 73 20 70 69 64 20 22 20 70 69 64 20 22 g as pid " pid "
2d90: 5c 6e 22 0a 09 09 09 20 20 20 20 20 20 20 22 20 \n".... "
2da0: 20 45 58 43 45 50 54 49 4f 4e 3a 20 22 20 28 28 EXCEPTION: " ((
2db0: 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 65 72 condition-proper
2dc0: 74 79 2d 61 63 63 65 73 73 6f 72 20 27 65 78 6e ty-accessor 'exn
2dd0: 20 27 6d 65 73 73 61 67 65 29 20 65 78 6e 29 29 'message) exn))
2de0: 0a 09 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 .. (debug:pr
2df0: 69 6e 74 20 31 20 22 53 65 6e 64 69 6e 67 20 73 int 1 "Sending s
2e00: 69 67 6e 61 6c 2f 74 65 72 6d 20 74 6f 20 22 20 ignal/term to "
2e10: 70 69 64 20 22 20 6f 6e 20 22 20 68 6f 73 74 6e pid " on " hostn
2e20: 61 6d 65 29 0a 09 20 20 20 20 20 28 70 72 6f 63 ame).. (proc
2e30: 65 73 73 2d 73 69 67 6e 61 6c 20 70 69 64 20 73 ess-signal pid s
2e40: 69 67 6e 61 6c 2f 74 65 72 6d 29 0a 09 20 20 20 ignal/term)..
2e50: 20 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 (thread-sleep!
2e60: 20 35 29 20 3b 3b 20 67 69 76 65 20 69 74 20 66 5) ;; give it f
2e70: 69 76 65 20 73 65 63 6f 6e 64 73 20 74 6f 20 64 ive seconds to d
2e80: 69 65 20 70 65 61 63 65 66 75 6c 6c 79 20 74 68 ie peacefully th
2e90: 65 6e 20 64 6f 20 61 20 62 72 75 74 61 6c 20 6b en do a brutal k
2ea0: 69 6c 6c 0a 09 20 20 20 20 20 3b 3b 28 70 72 6f ill.. ;;(pro
2eb0: 63 65 73 73 2d 73 69 67 6e 61 6c 20 70 69 64 20 cess-signal pid
2ec0: 73 69 67 6e 61 6c 2f 6b 69 6c 6c 29 0a 09 20 20 signal/kill)..
2ed0: 20 20 20 29 20 3b 3b 20 6c 6f 63 61 6c 20 6d 61 ) ;; local ma
2ee0: 63 68 69 6e 65 2c 20 73 65 6e 64 20 73 69 67 20 chine, send sig
2ef0: 74 65 72 6d 0a 09 20 20 20 20 28 62 65 67 69 6e term.. (begin
2f00: 0a 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 2d ...(debug:print-
2f10: 69 6e 66 6f 20 31 20 22 53 74 6f 70 70 69 6e 67 info 1 "Stopping
2f20: 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 73 20 remote servers
2f30: 6e 6f 74 20 79 65 74 20 73 75 70 70 6f 72 74 65 not yet supporte
2f40: 64 2e 22 29 29 29 29 0a 09 3b 3b 20 20 20 20 20 d."))))..;;
2f50: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
2f60: 66 6f 20 31 20 22 54 65 6c 6c 69 6e 67 20 61 6c fo 1 "Telling al
2f70: 69 76 65 20 73 65 72 76 65 72 20 6f 6e 20 22 20 ive server on "
2f80: 68 6f 73 74 6e 61 6d 65 20 22 3a 22 20 70 6f 72 hostname ":" por
2f90: 74 20 22 20 74 6f 20 63 6f 6d 6d 69 74 20 73 65 t " to commit se
2fa0: 72 76 65 72 63 69 64 65 22 29 0a 09 3b 3b 20 20 rvercide")..;;
2fb0: 20 20 20 20 28 6c 65 74 20 28 28 73 65 72 76 65 (let ((serve
2fc0: 72 64 61 74 20 28 6c 69 73 74 20 68 6f 73 74 6e rdat (list hostn
2fd0: 61 6d 65 20 70 6f 72 74 29 29 29 0a 09 3b 3b 09 ame port)))..;;.
2fe0: 28 63 61 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 (case (string->s
2ff0: 79 6d 62 6f 6c 20 74 72 61 6e 73 70 6f 72 74 29 ymbol transport)
3000: 0a 09 3b 3b 09 20 20 28 28 68 74 74 70 29 28 68 ..;;. ((http)(h
3010: 74 74 70 2d 74 72 61 6e 73 70 6f 72 74 3a 63 6c ttp-transport:cl
3020: 69 65 6e 74 2d 63 6f 6e 6e 65 63 74 20 68 6f 73 ient-connect hos
3030: 74 6e 61 6d 65 20 70 6f 72 74 29 29 0a 09 3b 3b tname port))..;;
3040: 09 20 20 28 65 6c 73 65 20 20 28 64 65 62 75 67 . (else (debug
3050: 3a 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 72 :print "ERROR: r
3060: 65 6d 6f 74 65 20 73 74 6f 70 70 69 6e 67 20 73 emote stopping s
3070: 65 72 76 65 72 73 20 6f 66 20 74 79 70 65 20 22 ervers of type "
3080: 20 74 72 61 6e 73 70 6f 72 74 20 22 20 6e 6f 74 transport " not
3090: 20 73 75 70 70 6f 72 74 65 64 20 79 65 74 22 29 supported yet")
30a0: 29 29 0a 09 3b 3b 09 28 63 64 62 3a 6b 69 6c 6c ))..;;.(cdb:kill
30b0: 2d 73 65 72 76 65 72 20 73 65 72 76 65 72 64 61 -server serverda
30c0: 74 29 29 29 29 29 20 20 20 20 3b 3b 20 72 65 6d t))))) ;; rem
30d0: 6f 74 65 20 6d 61 63 68 69 6e 65 2c 20 74 72 79 ote machine, try
30e0: 20 74 65 6c 6c 69 6e 67 20 73 65 72 76 65 72 20 telling server
30f0: 74 6f 20 63 6f 6d 6d 69 74 20 73 75 69 63 69 64 to commit suicid
3100: 65 0a 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 e. (begin..
3110: 28 69 66 20 73 74 61 74 75 73 20 0a 09 20 20 20 (if status ..
3120: 20 28 69 66 20 28 65 71 75 61 6c 3f 20 68 6f 73 (if (equal? hos
3130: 74 6e 61 6d 65 20 28 67 65 74 2d 68 6f 73 74 2d tname (get-host-
3140: 6e 61 6d 65 29 29 0a 09 09 28 62 65 67 69 6e 0a name))...(begin.
3150: 09 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
3160: 2d 69 6e 66 6f 20 31 20 22 53 65 6e 64 69 6e 67 -info 1 "Sending
3170: 20 73 69 67 6e 61 6c 2f 74 65 72 6d 20 74 6f 20 signal/term to
3180: 22 20 70 69 64 20 22 20 6f 6e 20 22 20 68 6f 73 " pid " on " hos
3190: 74 6e 61 6d 65 29 0a 09 09 20 20 28 70 72 6f 63 tname)... (proc
31a0: 65 73 73 2d 73 69 67 6e 61 6c 20 70 69 64 20 73 ess-signal pid s
31b0: 69 67 6e 61 6c 2f 74 65 72 6d 29 20 20 3b 3b 20 ignal/term) ;;
31c0: 6c 6f 63 61 6c 20 6d 61 63 68 69 6e 65 2c 20 73 local machine, s
31d0: 65 6e 64 20 73 69 67 20 74 65 72 6d 0a 09 09 20 end sig term...
31e0: 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 (thread-sleep!
31f0: 35 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 5)
3200: 20 20 20 3b 3b 20 67 69 76 65 20 69 74 20 66 69 ;; give it fi
3210: 76 65 20 73 65 63 6f 6e 64 73 20 74 6f 20 64 69 ve seconds to di
3220: 65 20 70 65 61 63 65 66 75 6c 6c 79 20 74 68 65 e peacefully the
3230: 6e 20 64 6f 20 61 20 62 72 75 74 61 6c 20 6b 69 n do a brutal ki
3240: 6c 6c 0a 09 09 20 20 28 70 72 6f 63 65 73 73 2d ll... (process-
3250: 73 69 67 6e 61 6c 20 70 69 64 20 73 69 67 6e 61 signal pid signa
3260: 6c 2f 6b 69 6c 6c 29 29 20 0a 09 09 28 64 65 62 l/kill)) ...(deb
3270: 75 67 3a 70 72 69 6e 74 20 30 20 22 57 41 52 4e ug:print 0 "WARN
3280: 49 4e 47 3a 20 43 61 6e 27 74 20 6b 69 6c 6c 20 ING: Can't kill
3290: 66 72 6f 7a 65 6e 20 73 65 72 76 65 72 20 6f 6e frozen server on
32a0: 20 72 65 6d 6f 74 65 20 68 6f 73 74 20 22 20 68 remote host " h
32b0: 6f 73 74 6e 61 6d 65 29 29 29 29 29 29 0a 0a 0a ostname))))))...
32c0: 0a 28 64 65 66 69 6e 65 20 28 74 61 73 6b 73 3a .(define (tasks:
32d0: 67 65 74 2d 61 6c 6c 2d 73 65 72 76 65 72 73 20 get-all-servers
32e0: 6d 64 62 29 0a 20 20 28 6c 65 74 20 28 28 72 65 mdb). (let ((re
32f0: 73 20 27 28 29 29 29 0a 20 20 20 20 28 73 71 6c s '())). (sql
3300: 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f ite3:for-each-ro
3310: 77 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 w. (lambda (
3320: 69 64 20 70 69 64 20 68 6f 73 74 6e 61 6d 65 20 id pid hostname
3330: 69 6e 74 65 72 66 61 63 65 20 70 6f 72 74 20 70 interface port p
3340: 75 62 70 6f 72 74 20 73 74 61 72 74 2d 74 69 6d ubport start-tim
3350: 65 20 70 72 69 6f 72 69 74 79 20 73 74 61 74 65 e priority state
3360: 20 6d 74 2d 76 65 72 73 69 6f 6e 20 6c 61 73 74 mt-version last
3370: 2d 75 70 64 61 74 65 20 74 72 61 6e 73 70 6f 72 -update transpor
3380: 74 29 0a 20 20 20 20 20 20 20 28 73 65 74 21 20 t). (set!
3390: 72 65 73 20 28 63 6f 6e 73 20 28 76 65 63 74 6f res (cons (vecto
33a0: 72 20 69 64 20 70 69 64 20 68 6f 73 74 6e 61 6d r id pid hostnam
33b0: 65 20 69 6e 74 65 72 66 61 63 65 20 70 6f 72 74 e interface port
33c0: 20 70 75 62 70 6f 72 74 20 73 74 61 72 74 2d 74 pubport start-t
33d0: 69 6d 65 20 70 72 69 6f 72 69 74 79 20 73 74 61 ime priority sta
33e0: 74 65 20 6d 74 2d 76 65 72 73 69 6f 6e 20 6c 61 te mt-version la
33f0: 73 74 2d 75 70 64 61 74 65 20 74 72 61 6e 73 70 st-update transp
3400: 6f 72 74 29 20 72 65 73 29 29 29 0a 20 20 20 20 ort) res))).
3410: 20 6d 64 62 0a 20 20 20 20 20 22 53 45 4c 45 43 mdb. "SELEC
3420: 54 20 69 64 2c 70 69 64 2c 68 6f 73 74 6e 61 6d T id,pid,hostnam
3430: 65 2c 69 6e 74 65 72 66 61 63 65 2c 70 6f 72 74 e,interface,port
3440: 2c 70 75 62 70 6f 72 74 2c 73 74 61 72 74 5f 74 ,pubport,start_t
3450: 69 6d 65 2c 70 72 69 6f 72 69 74 79 2c 73 74 61 ime,priority,sta
3460: 74 65 2c 6d 74 5f 76 65 72 73 69 6f 6e 2c 73 74 te,mt_version,st
3470: 72 66 74 69 6d 65 28 27 25 73 27 2c 27 6e 6f 77 rftime('%s','now
3480: 27 29 2d 68 65 61 72 74 62 65 61 74 20 41 53 20 ')-heartbeat AS
3490: 6c 61 73 74 5f 75 70 64 61 74 65 2c 74 72 61 6e last_update,tran
34a0: 73 70 6f 72 74 20 46 52 4f 4d 20 73 65 72 76 65 sport FROM serve
34b0: 72 73 20 4f 52 44 45 52 20 42 59 20 73 74 61 72 rs ORDER BY star
34c0: 74 5f 74 69 6d 65 20 44 45 53 43 3b 22 29 0a 20 t_time DESC;").
34d0: 20 20 20 72 65 73 29 29 0a 20 20 20 20 20 20 20 res)).
34e0: 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
34f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3500: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3510: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3520: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 54 61 ==========.;; Ta
3530: 73 6b 73 20 61 6e 64 20 54 61 73 6b 20 6d 6f 6e sks and Task mon
3540: 69 74 6f 72 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d itors.;;========
3550: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3560: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3570: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3580: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
3590: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
35a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
35b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
35c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
35d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 54 61 73 =========.;; Tas
35e0: 6b 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ks.;;===========
35f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3600: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3610: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3620: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 0a 0a 3b ===========....;
3630: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
3640: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3650: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3660: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3670: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 54 61 73 6b 20 =======.;; Task
3680: 4d 6f 6e 69 74 6f 72 73 0a 3b 3b 3d 3d 3d 3d 3d Monitors.;;=====
3690: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
36a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
36b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
36c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
36d0: 3d 0a 0a 28 64 65 66 69 6e 65 20 28 74 61 73 6b =..(define (task
36e0: 73 3a 72 65 67 69 73 74 65 72 2d 6d 6f 6e 69 74 s:register-monit
36f0: 6f 72 20 64 62 20 6d 64 62 29 0a 20 20 28 6c 65 or db mdb). (le
3700: 74 2a 20 28 28 70 69 64 20 28 63 75 72 72 65 6e t* ((pid (curren
3710: 74 2d 70 72 6f 63 65 73 73 2d 69 64 29 29 0a 09 t-process-id))..
3720: 20 28 68 6f 73 74 6e 61 6d 65 20 28 67 65 74 2d (hostname (get-
3730: 68 6f 73 74 2d 6e 61 6d 65 29 29 0a 09 20 28 75 host-name)).. (u
3740: 73 65 72 69 6e 66 6f 20 28 75 73 65 72 2d 69 6e serinfo (user-in
3750: 66 6f 72 6d 61 74 69 6f 6e 20 28 63 75 72 72 65 formation (curre
3760: 6e 74 2d 75 73 65 72 2d 69 64 29 29 29 0a 09 20 nt-user-id)))..
3770: 28 75 73 65 72 6e 61 6d 65 20 28 63 61 72 20 75 (username (car u
3780: 73 65 72 69 6e 66 6f 29 29 29 0a 20 20 20 20 28 serinfo))). (
3790: 70 72 69 6e 74 20 22 52 65 67 69 73 74 65 72 20 print "Register
37a0: 6d 6f 6e 69 74 6f 72 2c 20 70 69 64 3a 20 22 20 monitor, pid: "
37b0: 70 69 64 20 22 2c 20 68 6f 73 74 6e 61 6d 65 3a pid ", hostname:
37c0: 20 22 20 68 6f 73 74 6e 61 6d 65 20 22 2c 20 75 " hostname ", u
37d0: 73 65 72 6e 61 6d 65 3a 20 22 20 75 73 65 72 6e sername: " usern
37e0: 61 6d 65 29 0a 20 20 20 20 28 73 71 6c 69 74 65 ame). (sqlite
37f0: 33 3a 65 78 65 63 75 74 65 20 6d 64 62 20 22 49 3:execute mdb "I
3800: 4e 53 45 52 54 20 49 4e 54 4f 20 6d 6f 6e 69 74 NSERT INTO monit
3810: 6f 72 73 20 28 70 69 64 2c 73 74 61 72 74 5f 74 ors (pid,start_t
3820: 69 6d 65 2c 6c 61 73 74 5f 75 70 64 61 74 65 2c ime,last_update,
3830: 68 6f 73 74 6e 61 6d 65 2c 75 73 65 72 6e 61 6d hostname,usernam
3840: 65 29 20 56 41 4c 55 45 53 20 28 3f 2c 73 74 72 e) VALUES (?,str
3850: 66 74 69 6d 65 28 27 25 73 27 2c 27 6e 6f 77 27 ftime('%s','now'
3860: 29 2c 73 74 72 66 74 69 6d 65 28 27 25 73 27 2c ),strftime('%s',
3870: 27 6e 6f 77 27 29 2c 3f 2c 3f 29 3b 22 0a 09 09 'now'),?,?);"...
3880: 20 20 20 20 20 70 69 64 20 68 6f 73 74 6e 61 6d pid hostnam
3890: 65 20 75 73 65 72 6e 61 6d 65 29 29 29 0a 0a 28 e username)))..(
38a0: 64 65 66 69 6e 65 20 28 74 61 73 6b 73 3a 67 65 define (tasks:ge
38b0: 74 2d 6e 75 6d 2d 61 6c 69 76 65 2d 6d 6f 6e 69 t-num-alive-moni
38c0: 74 6f 72 73 20 6d 64 62 29 0a 20 20 28 6c 65 74 tors mdb). (let
38d0: 20 28 28 72 65 73 20 30 29 29 0a 20 20 20 20 28 ((res 0)). (
38e0: 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 sqlite3:for-each
38f0: 2d 72 6f 77 20 0a 20 20 20 20 20 28 6c 61 6d 62 -row . (lamb
3900: 64 61 20 28 63 6f 75 6e 74 29 0a 20 20 20 20 20 da (count).
3910: 20 20 28 73 65 74 21 20 72 65 73 20 63 6f 75 6e (set! res coun
3920: 74 29 29 0a 20 20 20 20 20 6d 64 62 0a 20 20 20 t)). mdb.
3930: 20 20 22 53 45 4c 45 43 54 20 63 6f 75 6e 74 28 "SELECT count(
3940: 69 64 29 20 46 52 4f 4d 20 6d 6f 6e 69 74 6f 72 id) FROM monitor
3950: 73 20 57 48 45 52 45 20 6c 61 73 74 5f 75 70 64 s WHERE last_upd
3960: 61 74 65 20 3c 20 28 73 74 72 66 74 69 6d 65 28 ate < (strftime(
3970: 27 25 73 27 2c 27 6e 6f 77 27 29 20 2d 20 33 30 '%s','now') - 30
3980: 30 29 20 41 4e 44 20 75 73 65 72 6e 61 6d 65 3d 0) AND username=
3990: 3f 3b 22 0a 20 20 20 20 20 28 63 61 72 20 28 75 ?;". (car (u
39a0: 73 65 72 2d 69 6e 66 6f 72 6d 61 74 69 6f 6e 20 ser-information
39b0: 28 63 75 72 72 65 6e 74 2d 75 73 65 72 2d 69 64 (current-user-id
39c0: 29 29 29 29 0a 20 20 20 20 72 65 73 29 29 0a 0a )))). res))..
39d0: 3b 3b 20 72 65 67 69 73 74 65 72 20 61 20 74 61 ;; register a ta
39e0: 73 6b 0a 28 64 65 66 69 6e 65 20 28 74 61 73 6b sk.(define (task
39f0: 73 3a 61 64 64 20 6d 64 62 20 61 63 74 69 6f 6e s:add mdb action
3a00: 20 6f 77 6e 65 72 20 74 61 72 67 65 74 20 72 75 owner target ru
3a10: 6e 6e 61 6d 65 20 74 65 73 74 20 69 74 65 6d 20 nname test item
3a20: 70 61 72 61 6d 73 29 0a 20 20 28 73 71 6c 69 74 params). (sqlit
3a30: 65 33 3a 65 78 65 63 75 74 65 20 6d 64 62 20 22 e3:execute mdb "
3a40: 49 4e 53 45 52 54 20 49 4e 54 4f 20 74 61 73 6b INSERT INTO task
3a50: 73 5f 71 75 65 75 65 20 28 61 63 74 69 6f 6e 2c s_queue (action,
3a60: 6f 77 6e 65 72 2c 73 74 61 74 65 2c 74 61 72 67 owner,state,targ
3a70: 65 74 2c 6e 61 6d 65 2c 74 65 73 74 2c 69 74 65 et,name,test,ite
3a80: 6d 2c 70 61 72 61 6d 73 2c 63 72 65 61 74 69 6f m,params,creatio
3a90: 6e 5f 74 69 6d 65 2c 65 78 65 63 75 74 69 6f 6e n_time,execution
3aa0: 5f 74 69 6d 65 29 0a 20 20 20 20 20 20 20 20 20 _time).
3ab0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 56 41 VA
3ac0: 4c 55 45 53 20 28 3f 2c 3f 2c 27 6e 65 77 27 2c LUES (?,?,'new',
3ad0: 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c 73 74 72 66 74 69 ?,?,?,?,?,strfti
3ae0: 6d 65 28 27 25 73 27 2c 27 6e 6f 77 27 29 2c 30 me('%s','now'),0
3af0: 29 3b 22 20 0a 09 09 20 20 20 61 63 74 69 6f 6e );" ... action
3b00: 0a 09 09 20 20 20 6f 77 6e 65 72 0a 09 09 20 20 ... owner...
3b10: 20 74 61 72 67 65 74 0a 09 09 20 20 20 72 75 6e target... run
3b20: 6e 61 6d 65 0a 09 09 20 20 20 74 65 73 74 0a 09 name... test..
3b30: 09 20 20 20 69 74 65 6d 0a 09 09 20 20 20 28 69 . item... (i
3b40: 66 20 70 61 72 61 6d 73 20 70 61 72 61 6d 73 20 f params params
3b50: 22 22 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 "")))..(define (
3b60: 6b 65 79 73 3a 6b 65 79 2d 76 61 6c 73 2d 68 61 keys:key-vals-ha
3b70: 73 68 2d 3e 74 61 72 67 65 74 20 6b 65 79 73 20 sh->target keys
3b80: 6b 65 79 2d 70 61 72 61 6d 73 29 0a 20 20 28 6c key-params). (l
3b90: 65 74 20 28 28 74 6d 70 20 28 68 61 73 68 2d 74 et ((tmp (hash-t
3ba0: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
3bb0: 20 6b 65 79 2d 70 61 72 61 6d 73 20 28 76 65 63 key-params (vec
3bc0: 74 6f 72 2d 72 65 66 20 28 63 61 72 20 6b 65 79 tor-ref (car key
3bd0: 73 29 20 30 29 20 22 22 29 29 29 0a 20 20 20 20 s) 0) ""))).
3be0: 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 6b (if (> (length k
3bf0: 65 79 73 29 20 31 29 0a 09 28 66 6f 72 2d 65 61 eys) 1)..(for-ea
3c00: 63 68 20 28 6c 61 6d 62 64 61 20 28 6b 65 79 29 ch (lambda (key)
3c10: 0a 09 09 20 20 20 20 28 73 65 74 21 20 74 6d 70 ... (set! tmp
3c20: 20 28 63 6f 6e 63 20 74 6d 70 20 22 2f 22 20 28 (conc tmp "/" (
3c30: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
3c40: 65 66 61 75 6c 74 20 6b 65 79 2d 70 61 72 61 6d efault key-param
3c50: 73 20 28 76 65 63 74 6f 72 2d 72 65 66 20 6b 65 s (vector-ref ke
3c60: 79 20 30 29 20 22 22 29 29 29 29 0a 09 09 20 20 y 0) ""))))...
3c70: 28 63 64 72 20 6b 65 79 73 29 29 29 0a 20 20 20 (cdr keys))).
3c80: 20 74 6d 70 29 29 0a 09 09 09 09 09 09 09 09 0a tmp))..........
3c90: 3b 3b 20 66 6f 72 20 75 73 65 20 66 72 6f 6d 20 ;; for use from
3ca0: 74 68 65 20 67 75 69 0a 28 64 65 66 69 6e 65 20 the gui.(define
3cb0: 28 74 61 73 6b 73 3a 61 64 64 2d 66 72 6f 6d 2d (tasks:add-from-
3cc0: 70 61 72 61 6d 73 20 6d 64 62 20 61 63 74 69 6f params mdb actio
3cd0: 6e 20 6b 65 79 73 20 6b 65 79 2d 70 61 72 61 6d n keys key-param
3ce0: 73 20 76 61 72 2d 70 61 72 61 6d 73 29 0a 20 20 s var-params).
3cf0: 28 6c 65 74 20 28 28 74 61 72 67 65 74 20 20 20 (let ((target
3d00: 20 28 6b 65 79 73 3a 6b 65 79 2d 76 61 6c 73 2d (keys:key-vals-
3d10: 68 61 73 68 2d 3e 74 61 72 67 65 74 20 6b 65 79 hash->target key
3d20: 73 20 6b 65 79 2d 70 61 72 61 6d 73 29 29 0a 09 s key-params))..
3d30: 28 6f 77 6e 65 72 20 20 20 20 20 28 63 61 72 20 (owner (car
3d40: 28 75 73 65 72 2d 69 6e 66 6f 72 6d 61 74 69 6f (user-informatio
3d50: 6e 20 28 63 75 72 72 65 6e 74 2d 75 73 65 72 2d n (current-user-
3d60: 69 64 29 29 29 29 0a 09 28 72 75 6e 6e 61 6d 65 id))))..(runname
3d70: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 (hash-table-r
3d80: 65 66 2f 64 65 66 61 75 6c 74 20 76 61 72 2d 70 ef/default var-p
3d90: 61 72 61 6d 73 20 22 72 75 6e 6e 61 6d 65 22 20 arams "runname"
3da0: 23 66 29 29 0a 09 28 74 65 73 74 70 61 74 74 73 #f))..(testpatts
3db0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
3dc0: 2f 64 65 66 61 75 6c 74 20 76 61 72 2d 70 61 72 /default var-par
3dd0: 61 6d 73 20 22 74 65 73 74 70 61 74 74 73 22 20 ams "testpatts"
3de0: 22 25 22 29 29 0a 09 28 70 61 72 61 6d 73 20 20 "%"))..(params
3df0: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 (hash-table-re
3e00: 66 2f 64 65 66 61 75 6c 74 20 76 61 72 2d 70 61 f/default var-pa
3e10: 72 61 6d 73 20 22 70 61 72 61 6d 73 22 20 20 20 rams "params"
3e20: 20 22 22 29 29 29 0a 20 20 20 20 28 74 61 73 6b ""))). (task
3e30: 73 3a 61 64 64 20 6d 64 62 20 61 63 74 69 6f 6e s:add mdb action
3e40: 20 6f 77 6e 65 72 20 74 61 72 67 65 74 20 72 75 owner target ru
3e50: 6e 6e 61 6d 65 20 74 65 73 74 70 61 74 74 73 20 nname testpatts
3e60: 70 61 72 61 6d 73 29 29 29 0a 0a 3b 3b 20 72 65 params)))..;; re
3e70: 74 75 72 6e 20 6f 6e 65 20 74 61 73 6b 20 66 72 turn one task fr
3e80: 6f 6d 20 74 68 6f 73 65 20 77 68 6f 20 61 72 65 om those who are
3e90: 20 27 6e 65 77 27 20 4f 52 20 27 77 61 69 74 69 'new' OR 'waiti
3ea0: 6e 67 27 20 41 4e 44 20 6d 6f 72 65 20 74 68 61 ng' AND more tha
3eb0: 6e 20 31 30 73 65 63 20 6f 6c 64 0a 3b 3b 0a 28 n 10sec old.;;.(
3ec0: 64 65 66 69 6e 65 20 28 74 61 73 6b 73 3a 73 6e define (tasks:sn
3ed0: 61 67 2d 61 2d 74 61 73 6b 20 6d 64 62 29 0a 20 ag-a-task mdb).
3ee0: 20 28 6c 65 74 20 28 28 72 65 73 20 20 20 20 23 (let ((res #
3ef0: 66 29 0a 09 28 6b 65 79 74 78 74 20 28 63 6f 6e f)..(keytxt (con
3f00: 63 20 28 63 75 72 72 65 6e 74 2d 70 72 6f 63 65 c (current-proce
3f10: 73 73 2d 69 64 29 20 22 2d 22 20 28 67 65 74 2d ss-id) "-" (get-
3f20: 68 6f 73 74 2d 6e 61 6d 65 29 20 22 2d 22 20 28 host-name) "-" (
3f30: 63 61 72 20 28 75 73 65 72 2d 69 6e 66 6f 72 6d car (user-inform
3f40: 61 74 69 6f 6e 20 28 63 75 72 72 65 6e 74 2d 75 ation (current-u
3f50: 73 65 72 2d 69 64 29 29 29 29 29 29 0a 0a 20 20 ser-id))))))..
3f60: 20 20 3b 3b 20 66 69 72 73 74 20 72 61 6e 64 6f ;; first rando
3f70: 6d 6c 79 20 73 65 74 20 61 20 6e 65 77 20 74 6f mly set a new to
3f80: 20 70 69 64 2d 68 6f 73 74 6e 61 6d 65 2d 68 6f pid-hostname-ho
3f90: 73 74 6e 61 6d 65 0a 20 20 20 20 28 73 71 6c 69 stname. (sqli
3fa0: 74 65 33 3a 65 78 65 63 75 74 65 0a 20 20 20 20 te3:execute.
3fb0: 20 6d 64 62 20 0a 20 20 20 20 20 22 55 50 44 41 mdb . "UPDA
3fc0: 54 45 20 74 61 73 6b 73 5f 71 75 65 75 65 20 53 TE tasks_queue S
3fd0: 45 54 20 6b 65 79 6c 6f 63 6b 3d 3f 20 57 48 45 ET keylock=? WHE
3fe0: 52 45 20 69 64 20 49 4e 0a 20 20 20 20 20 20 20 RE id IN.
3ff0: 20 28 53 45 4c 45 43 54 20 69 64 20 46 52 4f 4d (SELECT id FROM
4000: 20 74 61 73 6b 73 5f 71 75 65 75 65 20 0a 20 20 tasks_queue .
4010: 20 20 20 20 20 20 20 20 20 57 48 45 52 45 20 73 WHERE s
4020: 74 61 74 65 3d 27 6e 65 77 27 20 4f 52 20 0a 20 tate='new' OR .
4030: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4040: 28 73 74 61 74 65 3d 27 77 61 69 74 69 6e 67 27 (state='waiting'
4050: 20 41 4e 44 20 28 73 74 72 66 74 69 6d 65 28 27 AND (strftime('
4060: 25 73 27 2c 27 6e 6f 77 27 29 2d 65 78 65 63 75 %s','now')-execu
4070: 74 69 6f 6e 5f 74 69 6d 65 29 20 3e 20 31 30 29 tion_time) > 10)
4080: 20 4f 52 0a 20 20 20 20 20 20 20 20 20 20 20 20 OR.
4090: 20 20 20 20 20 73 74 61 74 65 3d 27 72 65 73 65 state='rese
40a0: 74 27 0a 20 20 20 20 20 20 20 20 20 20 20 4f 52 t'. OR
40b0: 44 45 52 20 42 59 20 52 41 4e 44 4f 4d 28 29 20 DER BY RANDOM()
40c0: 4c 49 4d 49 54 20 31 29 3b 22 20 6b 65 79 74 78 LIMIT 1);" keytx
40d0: 74 29 0a 0a 20 20 20 20 28 73 71 6c 69 74 65 33 t).. (sqlite3
40e0: 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 20 20 :for-each-row.
40f0: 20 20 20 28 6c 61 6d 62 64 61 20 28 69 64 20 2e (lambda (id .
4100: 20 72 65 6d 29 0a 20 20 20 20 20 20 20 28 73 65 rem). (se
4110: 74 21 20 72 65 73 20 28 61 70 70 6c 79 20 76 65 t! res (apply ve
4120: 63 74 6f 72 20 69 64 20 72 65 6d 29 29 29 0a 20 ctor id rem))).
4130: 20 20 20 20 6d 64 62 0a 20 20 20 20 20 22 53 45 mdb. "SE
4140: 4c 45 43 54 20 69 64 2c 61 63 74 69 6f 6e 2c 6f LECT id,action,o
4150: 77 6e 65 72 2c 73 74 61 74 65 2c 74 61 72 67 65 wner,state,targe
4160: 74 2c 6e 61 6d 65 2c 74 65 73 74 2c 69 74 65 6d t,name,test,item
4170: 2c 70 61 72 61 6d 73 2c 63 72 65 61 74 69 6f 6e ,params,creation
4180: 5f 74 69 6d 65 2c 65 78 65 63 75 74 69 6f 6e 5f _time,execution_
4190: 74 69 6d 65 20 46 52 4f 4d 20 74 61 73 6b 73 5f time FROM tasks_
41a0: 71 75 65 75 65 20 57 48 45 52 45 20 6b 65 79 6c queue WHERE keyl
41b0: 6f 63 6b 3d 3f 20 4f 52 44 45 52 20 42 59 20 65 ock=? ORDER BY e
41c0: 78 65 63 75 74 69 6f 6e 5f 74 69 6d 65 20 41 53 xecution_time AS
41d0: 43 20 4c 49 4d 49 54 20 31 3b 22 20 6b 65 79 74 C LIMIT 1;" keyt
41e0: 78 74 29 0a 20 20 20 20 28 69 66 20 72 65 73 20 xt). (if res
41f0: 3b 3b 20 79 65 70 2c 20 68 61 76 65 20 77 6f 72 ;; yep, have wor
4200: 6b 20 74 6f 20 62 65 20 64 6f 6e 65 0a 09 28 62 k to be done..(b
4210: 65 67 69 6e 0a 09 20 20 28 73 71 6c 69 74 65 33 egin.. (sqlite3
4220: 3a 65 78 65 63 75 74 65 20 6d 64 62 20 22 55 50 :execute mdb "UP
4230: 44 41 54 45 20 74 61 73 6b 73 5f 71 75 65 75 65 DATE tasks_queue
4240: 20 53 45 54 20 73 74 61 74 65 3d 27 69 6e 70 72 SET state='inpr
4250: 6f 67 72 65 73 73 27 2c 65 78 65 63 75 74 69 6f ogress',executio
4260: 6e 5f 74 69 6d 65 3d 73 74 72 66 74 69 6d 65 28 n_time=strftime(
4270: 27 25 73 27 2c 27 6e 6f 77 27 29 20 57 48 45 52 '%s','now') WHER
4280: 45 20 69 64 3d 3f 3b 22 0a 09 09 09 20 20 20 28 E id=?;".... (
4290: 74 61 73 6b 73 3a 74 61 73 6b 2d 67 65 74 2d 69 tasks:task-get-i
42a0: 64 20 72 65 73 29 29 0a 09 20 20 72 65 73 29 0a d res)).. res).
42b0: 09 23 66 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 .#f)))..(define
42c0: 28 74 61 73 6b 73 3a 72 65 73 65 74 2d 73 74 75 (tasks:reset-stu
42d0: 63 6b 2d 74 61 73 6b 73 20 6d 64 62 29 0a 20 20 ck-tasks mdb).
42e0: 28 6c 65 74 20 28 28 72 65 73 20 27 28 29 29 29 (let ((res '()))
42f0: 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f . (sqlite3:fo
4300: 72 2d 65 61 63 68 2d 72 6f 77 0a 20 20 20 20 20 r-each-row.
4310: 28 6c 61 6d 62 64 61 20 28 69 64 20 64 65 6c 74 (lambda (id delt
4320: 61 29 0a 20 20 20 20 20 20 20 28 73 65 74 21 20 a). (set!
4330: 72 65 73 20 28 63 6f 6e 73 20 69 64 20 72 65 73 res (cons id res
4340: 29 29 29 0a 20 20 20 20 20 6d 64 62 0a 20 20 20 ))). mdb.
4350: 20 20 22 53 45 4c 45 43 54 20 69 64 2c 73 74 72 "SELECT id,str
4360: 66 74 69 6d 65 28 27 25 73 27 2c 27 6e 6f 77 27 ftime('%s','now'
4370: 29 2d 65 78 65 63 75 74 69 6f 6e 5f 74 69 6d 65 )-execution_time
4380: 20 41 53 20 64 65 6c 74 61 20 46 52 4f 4d 20 74 AS delta FROM t
4390: 61 73 6b 73 5f 71 75 65 75 65 20 57 48 45 52 45 asks_queue WHERE
43a0: 20 73 74 61 74 65 3d 27 69 6e 70 72 6f 67 72 65 state='inprogre
43b0: 73 73 27 20 41 4e 44 20 64 65 6c 74 61 3e 37 30 ss' AND delta>70
43c0: 30 20 4f 52 44 45 52 20 42 59 20 64 65 6c 74 61 0 ORDER BY delta
43d0: 20 44 45 53 43 20 4c 49 4d 49 54 20 32 3b 22 29 DESC LIMIT 2;")
43e0: 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 . (sqlite3:ex
43f0: 65 63 75 74 65 20 0a 20 20 20 20 20 6d 64 62 20 ecute . mdb
4400: 0a 20 20 20 20 20 28 63 6f 6e 63 20 22 55 50 44 . (conc "UPD
4410: 41 54 45 20 74 61 73 6b 73 5f 71 75 65 75 65 20 ATE tasks_queue
4420: 53 45 54 20 73 74 61 74 65 3d 27 72 65 73 65 74 SET state='reset
4430: 27 20 57 48 45 52 45 20 69 64 20 49 4e 20 28 27 ' WHERE id IN ('
4440: 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 " (string-inters
4450: 70 65 72 73 65 20 28 6d 61 70 20 63 6f 6e 63 20 perse (map conc
4460: 72 65 73 29 20 22 27 2c 27 22 29 20 22 27 29 3b res) "','") "');
4470: 22 29 29 29 29 0a 0a 3b 3b 20 72 65 74 75 72 6e "))))..;; return
4480: 20 61 6c 6c 20 74 61 73 6b 73 20 69 6e 20 74 68 all tasks in th
4490: 65 20 74 61 73 6b 73 5f 71 75 65 75 65 20 74 61 e tasks_queue ta
44a0: 62 6c 65 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 ble.;;.(define (
44b0: 74 61 73 6b 73 3a 67 65 74 2d 74 61 73 6b 73 20 tasks:get-tasks
44c0: 6d 64 62 20 74 79 70 65 73 20 73 74 61 74 65 73 mdb types states
44d0: 29 0a 20 20 28 6c 65 74 20 28 28 72 65 73 20 27 ). (let ((res '
44e0: 28 29 29 29 0a 20 20 20 20 28 73 71 6c 69 74 65 ())). (sqlite
44f0: 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 20 3:for-each-row.
4500: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 69 64 20 (lambda (id
4510: 2e 20 72 65 6d 29 0a 20 20 20 20 20 20 20 28 73 . rem). (s
4520: 65 74 21 20 72 65 73 20 28 63 6f 6e 73 20 28 61 et! res (cons (a
4530: 70 70 6c 79 20 76 65 63 74 6f 72 20 69 64 20 72 pply vector id r
4540: 65 6d 29 20 72 65 73 29 29 29 0a 20 20 20 20 20 em) res))).
4550: 6d 64 62 0a 20 20 20 20 20 28 63 6f 6e 63 20 22 mdb. (conc "
4560: 53 45 4c 45 43 54 20 69 64 2c 61 63 74 69 6f 6e SELECT id,action
4570: 2c 6f 77 6e 65 72 2c 73 74 61 74 65 2c 74 61 72 ,owner,state,tar
4580: 67 65 74 2c 6e 61 6d 65 2c 74 65 73 74 2c 69 74 get,name,test,it
4590: 65 6d 2c 70 61 72 61 6d 73 2c 63 72 65 61 74 69 em,params,creati
45a0: 6f 6e 5f 74 69 6d 65 2c 65 78 65 63 75 74 69 6f on_time,executio
45b0: 6e 5f 74 69 6d 65 20 0a 20 20 20 20 20 20 20 20 n_time .
45c0: 20 20 20 20 20 20 20 46 52 4f 4d 20 74 61 73 6b FROM task
45d0: 73 5f 71 75 65 75 65 20 22 0a 20 20 20 20 20 20 s_queue ".
45e0: 20 20 20 20 20 20 20 20 20 3b 3b 20 57 48 45 52 ;; WHER
45f0: 45 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 E .
4600: 20 20 20 3b 3b 20 20 20 73 74 61 74 65 20 49 4e ;; state IN
4610: 20 22 20 73 74 61 74 65 73 73 74 72 20 22 20 41 " statesstr " A
4620: 4e 44 20 0a 09 20 20 20 20 20 20 20 3b 3b 20 20 ND .. ;;
4630: 20 61 63 74 69 6f 6e 20 49 4e 20 22 20 61 63 74 action IN " act
4640: 69 6f 6e 73 73 74 72 20 0a 09 20 20 20 22 20 4f ionsstr .. " O
4650: 52 44 45 52 20 42 59 20 63 72 65 61 74 69 6f 6e RDER BY creation
4660: 5f 74 69 6d 65 20 44 45 53 43 3b 22 29 29 0a 20 _time DESC;")).
4670: 20 20 20 72 65 73 29 29 0a 0a 3b 3b 20 72 65 6d res))..;; rem
4680: 6f 76 65 20 74 61 73 6b 73 20 67 69 76 65 6e 20 ove tasks given
4690: 62 79 20 61 20 73 74 72 69 6e 67 20 6f 66 20 6e by a string of n
46a0: 75 6d 62 65 72 73 20 63 6f 6d 6d 61 20 73 65 70 umbers comma sep
46b0: 61 72 61 74 65 64 0a 28 64 65 66 69 6e 65 20 28 arated.(define (
46c0: 74 61 73 6b 73 3a 72 65 6d 6f 76 65 2d 71 75 65 tasks:remove-que
46d0: 75 65 2d 65 6e 74 72 69 65 73 20 6d 64 62 20 74 ue-entries mdb t
46e0: 61 73 6b 2d 69 64 73 29 0a 20 20 28 73 71 6c 69 ask-ids). (sqli
46f0: 74 65 33 3a 65 78 65 63 75 74 65 20 6d 64 62 20 te3:execute mdb
4700: 28 63 6f 6e 63 20 22 44 45 4c 45 54 45 20 46 52 (conc "DELETE FR
4710: 4f 4d 20 74 61 73 6b 73 5f 71 75 65 75 65 20 57 OM tasks_queue W
4720: 48 45 52 45 20 69 64 20 49 4e 20 28 22 20 74 61 HERE id IN (" ta
4730: 73 6b 2d 69 64 73 20 22 29 3b 22 29 29 29 0a 0a sk-ids ");")))..
4740: 3b 3b 20 0a 28 64 65 66 69 6e 65 20 28 74 61 73 ;; .(define (tas
4750: 6b 73 3a 73 74 61 72 74 2d 6d 6f 6e 69 74 6f 72 ks:start-monitor
4760: 20 64 62 20 6d 64 62 29 0a 20 20 28 69 66 20 28 db mdb). (if (
4770: 3e 20 28 74 61 73 6b 73 3a 67 65 74 2d 6e 75 6d > (tasks:get-num
4780: 2d 61 6c 69 76 65 2d 6d 6f 6e 69 74 6f 72 73 20 -alive-monitors
4790: 6d 64 62 29 20 32 29 20 3b 3b 20 68 61 76 65 20 mdb) 2) ;; have
47a0: 74 77 6f 20 72 75 6e 6e 69 6e 67 2c 20 6e 6f 20 two running, no
47b0: 6e 65 65 64 20 66 6f 72 20 6d 6f 72 65 0a 20 20 need for more.
47c0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
47d0: 2d 69 6e 66 6f 20 31 20 22 4e 6f 74 20 73 74 61 -info 1 "Not sta
47e0: 72 74 69 6e 67 20 6d 6f 6e 69 74 6f 72 2c 20 61 rting monitor, a
47f0: 6c 72 65 61 64 79 20 68 61 76 65 20 6d 6f 72 65 lready have more
4800: 20 74 68 61 6e 20 74 77 6f 20 72 75 6e 6e 69 6e than two runnin
4810: 67 22 29 0a 20 20 20 20 20 20 28 6c 65 74 2a 20 g"). (let*
4820: 28 28 6d 65 67 61 74 65 73 74 64 62 20 20 20 20 ((megatestdb
4830: 20 28 63 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a (conc *toppath*
4840: 20 22 2f 6d 65 67 61 74 65 73 74 2e 64 62 22 29 "/megatest.db")
4850: 29 0a 09 20 20 20 20 20 28 6d 6f 6e 69 74 6f 72 ).. (monitor
4860: 64 62 66 20 20 20 20 20 28 63 6f 6e 63 20 2a 74 dbf (conc *t
4870: 6f 70 70 61 74 68 2a 20 22 2f 6d 6f 6e 69 74 6f oppath* "/monito
4880: 72 2e 64 62 22 29 29 0a 09 20 20 20 20 20 28 6c r.db")).. (l
4890: 61 73 74 2d 64 62 2d 75 70 64 61 74 65 20 30 29 ast-db-update 0)
48a0: 29 20 3b 3b 20 28 66 69 6c 65 2d 6d 6f 64 69 66 ) ;; (file-modif
48b0: 69 63 61 74 69 6f 6e 2d 74 69 6d 65 20 6d 65 67 ication-time meg
48c0: 61 74 65 73 74 64 62 29 29 29 0a 09 28 74 61 73 atestdb)))..(tas
48d0: 6b 3a 72 65 67 69 73 74 65 72 2d 6d 6f 6e 69 74 k:register-monit
48e0: 6f 72 20 6d 64 62 29 0a 09 28 6c 65 74 20 6c 6f or mdb)..(let lo
48f0: 6f 70 20 28 28 63 6f 75 6e 74 20 20 20 20 20 20 op ((count
4900: 30 29 0a 09 09 20 20 20 28 6e 65 78 74 2d 74 6f 0)... (next-to
4910: 75 63 68 20 30 29 29 20 3b 3b 20 6e 65 78 74 2d uch 0)) ;; next-
4920: 74 6f 75 63 68 20 69 73 20 74 68 65 20 74 69 6d touch is the tim
4930: 65 20 77 68 65 72 65 20 77 65 20 6e 65 65 64 20 e where we need
4940: 74 6f 20 75 70 64 61 74 65 20 6c 61 73 74 5f 75 to update last_u
4950: 70 64 61 74 65 0a 09 20 20 3b 3b 20 69 66 20 74 pdate.. ;; if t
4960: 68 65 20 64 62 20 68 61 73 20 62 65 65 6e 20 6d he db has been m
4970: 6f 64 69 66 69 65 64 20 77 65 27 64 20 62 65 73 odified we'd bes
4980: 74 20 6c 6f 6f 6b 20 61 74 20 74 68 65 20 74 61 t look at the ta
4990: 73 6b 20 71 75 65 75 65 0a 09 20 20 28 6c 65 74 sk queue.. (let
49a0: 20 28 28 6d 6f 64 74 69 6d 65 20 28 66 69 6c 65 ((modtime (file
49b0: 2d 6d 6f 64 69 66 69 63 61 74 69 6f 6e 2d 74 69 -modification-ti
49c0: 6d 65 20 6d 65 67 61 74 65 73 74 64 62 70 61 74 me megatestdbpat
49d0: 68 20 29 29 29 0a 09 20 20 20 20 28 69 66 20 28 h ))).. (if (
49e0: 3e 20 6d 6f 64 74 69 6d 65 20 6c 61 73 74 2d 64 > modtime last-d
49f0: 62 2d 75 70 64 61 74 65 29 0a 09 09 28 74 61 73 b-update)...(tas
4a00: 6b 73 3a 70 72 6f 63 65 73 73 2d 71 75 65 75 65 ks:process-queue
4a10: 20 64 62 20 6d 64 62 20 6c 61 73 74 2d 64 62 2d db mdb last-db-
4a20: 75 70 64 61 74 65 20 6d 65 67 61 74 65 73 74 64 update megatestd
4a30: 62 20 6e 65 78 74 2d 74 6f 75 63 68 29 29 0a 09 b next-touch))..
4a40: 20 20 20 20 3b 3b 20 57 41 52 4e 49 4e 47 3a 20 ;; WARNING:
4a50: 50 6f 73 73 69 62 6c 65 20 72 61 63 65 20 63 6f Possible race co
4a60: 6e 64 69 74 6f 6e 20 68 65 72 65 21 21 0a 09 20 nditon here!!..
4a70: 20 20 20 3b 3b 20 73 68 6f 75 6c 64 20 74 68 69 ;; should thi
4a80: 73 20 75 70 64 61 74 65 20 62 65 20 69 6d 6d 65 s update be imme
4a90: 64 69 61 74 65 6c 79 20 61 66 74 65 72 20 74 68 diately after th
4aa0: 65 20 74 61 73 6b 2d 67 65 74 2d 61 63 74 69 6f e task-get-actio
4ab0: 6e 20 63 61 6c 6c 20 61 62 6f 76 65 3f 0a 09 20 n call above?..
4ac0: 20 20 20 28 69 66 20 28 3e 20 28 63 75 72 72 65 (if (> (curre
4ad0: 6e 74 2d 73 65 63 6f 6e 64 73 29 20 6e 65 78 74 nt-seconds) next
4ae0: 2d 74 6f 75 63 68 29 0a 09 09 28 62 65 67 69 6e -touch)...(begin
4af0: 0a 09 09 20 20 28 74 61 73 6b 73 3a 6d 6f 6e 69 ... (tasks:moni
4b00: 74 6f 72 73 2d 75 70 64 61 74 65 20 6d 64 62 29 tors-update mdb)
4b10: 0a 09 09 20 20 28 6c 6f 6f 70 20 28 2b 20 63 6f ... (loop (+ co
4b20: 75 6e 74 20 31 29 28 2b 20 28 63 75 72 72 65 6e unt 1)(+ (curren
4b30: 74 2d 73 65 63 6f 6e 64 73 29 20 32 34 30 29 29 t-seconds) 240))
4b40: 29 0a 09 09 28 6c 6f 6f 70 20 28 2b 20 63 6f 75 )...(loop (+ cou
4b50: 6e 74 20 31 29 20 6e 65 78 74 2d 74 6f 75 63 68 nt 1) next-touch
4b60: 29 29 29 29 29 29 29 0a 20 20 20 20 20 20 0a 28 ))))))). .(
4b70: 64 65 66 69 6e 65 20 28 74 61 73 6b 73 3a 70 72 define (tasks:pr
4b80: 6f 63 65 73 73 2d 71 75 65 75 65 20 64 62 20 6d ocess-queue db m
4b90: 64 62 29 0a 20 20 28 6c 65 74 2a 20 28 28 74 61 db). (let* ((ta
4ba0: 73 6b 20 20 20 28 74 61 73 6b 73 3a 73 6e 61 67 sk (tasks:snag
4bb0: 2d 61 2d 74 61 73 6b 20 6d 64 62 29 29 0a 09 20 -a-task mdb))..
4bc0: 28 61 63 74 69 6f 6e 20 28 69 66 20 74 61 73 6b (action (if task
4bd0: 20 28 74 61 73 6b 73 3a 74 61 73 6b 2d 67 65 74 (tasks:task-get
4be0: 2d 61 63 74 69 6f 6e 20 74 61 73 6b 29 20 23 66 -action task) #f
4bf0: 29 29 29 0a 20 20 20 20 28 69 66 20 61 63 74 69 ))). (if acti
4c00: 6f 6e 20 28 70 72 69 6e 74 20 22 74 61 73 6b 73 on (print "tasks
4c10: 3a 70 72 6f 63 65 73 73 2d 71 75 65 75 65 20 74 :process-queue t
4c20: 61 73 6b 3a 20 22 20 74 61 73 6b 29 29 0a 20 20 ask: " task)).
4c30: 20 20 28 69 66 20 61 63 74 69 6f 6e 0a 09 28 63 (if action..(c
4c40: 61 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d ase (string->sym
4c50: 62 6f 6c 20 61 63 74 69 6f 6e 29 0a 09 20 20 28 bol action).. (
4c60: 28 72 75 6e 29 20 20 20 20 20 20 20 28 74 61 73 (run) (tas
4c70: 6b 73 3a 73 74 61 72 74 2d 72 75 6e 20 20 20 64 ks:start-run d
4c80: 62 20 6d 64 62 20 74 61 73 6b 29 29 0a 09 20 20 b mdb task))..
4c90: 28 28 72 65 6d 6f 76 65 29 20 20 20 20 28 74 61 ((remove) (ta
4ca0: 73 6b 73 3a 72 65 6d 6f 76 65 2d 72 75 6e 73 20 sks:remove-runs
4cb0: 64 62 20 6d 64 62 20 74 61 73 6b 29 29 0a 09 20 db mdb task))..
4cc0: 20 28 28 6c 6f 63 6b 29 20 20 20 20 20 20 28 74 ((lock) (t
4cd0: 61 73 6b 73 3a 6c 6f 63 6b 2d 72 75 6e 73 20 20 asks:lock-runs
4ce0: 20 64 62 20 6d 64 62 20 74 61 73 6b 29 29 0a 09 db mdb task))..
4cf0: 20 20 3b 3b 20 28 28 6d 6f 6e 69 74 6f 72 29 20 ;; ((monitor)
4d00: 20 20 28 74 61 73 6b 73 3a 73 74 61 72 74 2d 6d (tasks:start-m
4d10: 6f 6e 69 74 6f 72 20 64 62 20 74 61 73 6b 29 29 onitor db task))
4d20: 0a 09 20 20 28 28 72 6f 6c 6c 75 70 29 20 20 20 .. ((rollup)
4d30: 20 28 74 61 73 6b 73 3a 72 6f 6c 6c 75 70 2d 72 (tasks:rollup-r
4d40: 75 6e 73 20 64 62 20 6d 64 62 20 74 61 73 6b 29 uns db mdb task)
4d50: 29 0a 09 20 20 28 28 75 70 64 61 74 65 6d 65 74 ).. ((updatemet
4d60: 61 29 28 74 61 73 6b 73 3a 75 70 64 61 74 65 2d a)(tasks:update-
4d70: 6d 65 74 61 20 64 62 20 6d 64 62 20 74 61 73 6b meta db mdb task
4d80: 29 29 0a 09 20 20 28 28 6b 69 6c 6c 29 20 20 20 )).. ((kill)
4d90: 20 20 20 28 74 61 73 6b 73 3a 6b 69 6c 6c 2d 6d (tasks:kill-m
4da0: 6f 6e 69 74 6f 72 73 20 64 62 20 6d 64 62 20 74 onitors db mdb t
4db0: 61 73 6b 29 29 29 29 29 29 0a 0a 28 64 65 66 69 ask))))))..(defi
4dc0: 6e 65 20 28 74 61 73 6b 73 3a 67 65 74 2d 6d 6f ne (tasks:get-mo
4dd0: 6e 69 74 6f 72 73 20 6d 64 62 29 0a 20 20 28 6c nitors mdb). (l
4de0: 65 74 20 28 28 72 65 73 20 27 28 29 29 29 0a 20 et ((res '())).
4df0: 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d (sqlite3:for-
4e00: 65 61 63 68 2d 72 6f 77 0a 20 20 20 20 20 28 6c each-row. (l
4e10: 61 6d 62 64 61 20 28 61 20 2e 20 72 65 6d 29 0a ambda (a . rem).
4e20: 20 20 20 20 20 20 20 28 73 65 74 21 20 72 65 73 (set! res
4e30: 20 28 63 6f 6e 73 20 28 61 70 70 6c 79 20 76 65 (cons (apply ve
4e40: 63 74 6f 72 20 61 20 72 65 6d 29 20 72 65 73 29 ctor a rem) res)
4e50: 29 29 0a 20 20 20 20 20 6d 64 62 0a 20 20 20 20 )). mdb.
4e60: 20 22 53 45 4c 45 43 54 20 69 64 2c 70 69 64 2c "SELECT id,pid,
4e70: 73 74 72 66 74 69 6d 65 28 27 25 6d 2f 25 64 2f strftime('%m/%d/
4e80: 25 59 20 25 48 3a 25 4d 27 2c 64 61 74 65 74 69 %Y %H:%M',dateti
4e90: 6d 65 28 73 74 61 72 74 5f 74 69 6d 65 2c 27 75 me(start_time,'u
4ea0: 6e 69 78 65 70 6f 63 68 27 29 2c 27 6c 6f 63 61 nixepoch'),'loca
4eb0: 6c 74 69 6d 65 27 29 2c 73 74 72 66 74 69 6d 65 ltime'),strftime
4ec0: 28 27 25 6d 2f 25 64 2f 25 59 20 25 48 3a 25 4d ('%m/%d/%Y %H:%M
4ed0: 3a 25 53 27 2c 64 61 74 65 74 69 6d 65 28 6c 61 :%S',datetime(la
4ee0: 73 74 5f 75 70 64 61 74 65 2c 27 75 6e 69 78 65 st_update,'unixe
4ef0: 70 6f 63 68 27 29 2c 27 6c 6f 63 61 6c 74 69 6d poch'),'localtim
4f00: 65 27 29 2c 68 6f 73 74 6e 61 6d 65 2c 75 73 65 e'),hostname,use
4f10: 72 6e 61 6d 65 20 46 52 4f 4d 20 6d 6f 6e 69 74 rname FROM monit
4f20: 6f 72 73 20 4f 52 44 45 52 20 42 59 20 6c 61 73 ors ORDER BY las
4f30: 74 5f 75 70 64 61 74 65 20 41 53 43 3b 22 29 0a t_update ASC;").
4f40: 20 20 20 20 28 72 65 76 65 72 73 65 20 72 65 73 (reverse res
4f50: 29 0a 20 20 20 20 29 29 0a 0a 28 64 65 66 69 6e ). ))..(defin
4f60: 65 20 28 74 61 73 6b 73 3a 74 61 73 6b 73 2d 3e e (tasks:tasks->
4f70: 74 65 78 74 20 74 61 73 6b 73 29 0a 20 20 28 6c text tasks). (l
4f80: 65 74 20 28 28 66 6d 74 73 74 72 20 22 7e 31 30 et ((fmtstr "~10
4f90: 61 7e 31 30 61 7e 31 30 61 7e 31 32 61 7e 32 30 a~10a~10a~12a~20
4fa0: 61 7e 31 32 61 7e 31 32 61 7e 31 30 61 22 29 29 a~12a~12a~10a"))
4fb0: 0a 20 20 20 20 28 63 6f 6e 63 20 28 66 6f 72 6d . (conc (form
4fc0: 61 74 20 23 66 20 66 6d 74 73 74 72 20 22 69 64 at #f fmtstr "id
4fd0: 22 20 22 61 63 74 69 6f 6e 22 20 22 6f 77 6e 65 " "action" "owne
4fe0: 72 22 20 22 73 74 61 74 65 22 20 22 74 61 72 67 r" "state" "targ
4ff0: 65 74 22 20 22 72 75 6e 6e 61 6d 65 22 20 22 74 et" "runname" "t
5000: 65 73 74 70 61 74 74 73 22 20 22 70 61 72 61 6d estpatts" "param
5010: 73 22 29 20 22 5c 6e 22 0a 09 20 20 28 73 74 72 s") "\n".. (str
5020: 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 ing-intersperse
5030: 0a 09 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 .. (map (lambd
5040: 61 20 28 74 61 73 6b 29 0a 09 09 20 20 28 66 6f a (task)... (fo
5050: 72 6d 61 74 20 23 66 20 66 6d 74 73 74 72 0a 09 rmat #f fmtstr..
5060: 09 09 20 20 28 74 61 73 6b 73 3a 74 61 73 6b 2d .. (tasks:task-
5070: 67 65 74 2d 69 64 20 20 20 20 20 74 61 73 6b 29 get-id task)
5080: 0a 09 09 09 20 20 28 74 61 73 6b 73 3a 74 61 73 .... (tasks:tas
5090: 6b 2d 67 65 74 2d 61 63 74 69 6f 6e 20 74 61 73 k-get-action tas
50a0: 6b 29 0a 09 09 09 20 20 28 74 61 73 6b 73 3a 74 k).... (tasks:t
50b0: 61 73 6b 2d 67 65 74 2d 6f 77 6e 65 72 20 20 74 ask-get-owner t
50c0: 61 73 6b 29 0a 09 09 09 20 20 28 74 61 73 6b 73 ask).... (tasks
50d0: 3a 74 61 73 6b 2d 67 65 74 2d 73 74 61 74 65 20 :task-get-state
50e0: 20 74 61 73 6b 29 0a 09 09 09 20 20 28 74 61 73 task).... (tas
50f0: 6b 73 3a 74 61 73 6b 2d 67 65 74 2d 74 61 72 67 ks:task-get-targ
5100: 65 74 20 74 61 73 6b 29 0a 09 09 09 20 20 28 74 et task).... (t
5110: 61 73 6b 73 3a 74 61 73 6b 2d 67 65 74 2d 6e 61 asks:task-get-na
5120: 6d 65 20 20 20 74 61 73 6b 29 0a 09 09 09 20 20 me task)....
5130: 28 74 61 73 6b 73 3a 74 61 73 6b 2d 67 65 74 2d (tasks:task-get-
5140: 74 65 73 74 20 20 20 74 61 73 6b 29 0a 09 09 09 test task)....
5150: 20 20 3b 3b 20 28 74 61 73 6b 73 3a 74 61 73 6b ;; (tasks:task
5160: 2d 67 65 74 2d 69 74 65 6d 20 20 20 74 61 73 6b -get-item task
5170: 29 0a 09 09 09 20 20 28 74 61 73 6b 73 3a 74 61 ).... (tasks:ta
5180: 73 6b 2d 67 65 74 2d 70 61 72 61 6d 73 20 74 61 sk-get-params ta
5190: 73 6b 29 29 29 0a 09 09 74 61 73 6b 73 29 20 22 sk)))...tasks) "
51a0: 5c 6e 22 29 29 29 29 0a 20 20 20 0a 28 64 65 66 \n")))). .(def
51b0: 69 6e 65 20 28 74 61 73 6b 73 3a 6d 6f 6e 69 74 ine (tasks:monit
51c0: 6f 72 73 2d 3e 74 65 78 74 2d 74 61 62 6c 65 20 ors->text-table
51d0: 6d 6f 6e 69 74 6f 72 73 29 0a 20 20 28 6c 65 74 monitors). (let
51e0: 20 28 28 66 6d 74 73 74 72 20 22 7e 34 61 7e 38 ((fmtstr "~4a~8
51f0: 61 7e 32 30 61 7e 32 30 61 7e 31 30 61 7e 31 30 a~20a~20a~10a~10
5200: 61 22 29 29 0a 20 20 20 20 28 63 6f 6e 63 20 28 a")). (conc (
5210: 66 6f 72 6d 61 74 20 23 66 20 66 6d 74 73 74 72 format #f fmtstr
5220: 20 22 69 64 22 20 22 70 69 64 22 20 22 73 74 61 "id" "pid" "sta
5230: 72 74 20 74 69 6d 65 22 20 22 6c 61 73 74 20 75 rt time" "last u
5240: 70 64 61 74 65 22 20 22 68 6f 73 74 6e 61 6d 65 pdate" "hostname
5250: 22 20 22 75 73 65 72 22 29 20 22 5c 6e 22 0a 09 " "user") "\n"..
5260: 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 (string-inters
5270: 70 65 72 73 65 20 0a 09 20 20 20 28 6d 61 70 20 perse .. (map
5280: 28 6c 61 6d 62 64 61 20 28 6d 6f 6e 69 74 6f 72 (lambda (monitor
5290: 29 0a 09 09 20 20 28 66 6f 72 6d 61 74 20 23 66 )... (format #f
52a0: 20 66 6d 74 73 74 72 0a 09 09 09 20 20 28 74 61 fmtstr.... (ta
52b0: 73 6b 73 3a 6d 6f 6e 69 74 6f 72 2d 67 65 74 2d sks:monitor-get-
52c0: 69 64 20 20 20 20 20 20 20 20 20 20 6d 6f 6e 69 id moni
52d0: 74 6f 72 29 0a 09 09 09 20 20 28 74 61 73 6b 73 tor).... (tasks
52e0: 3a 6d 6f 6e 69 74 6f 72 2d 67 65 74 2d 70 69 64 :monitor-get-pid
52f0: 20 20 20 20 20 20 20 20 20 6d 6f 6e 69 74 6f 72 monitor
5300: 29 0a 09 09 09 20 20 28 74 61 73 6b 73 3a 6d 6f ).... (tasks:mo
5310: 6e 69 74 6f 72 2d 67 65 74 2d 73 74 61 72 74 5f nitor-get-start_
5320: 74 69 6d 65 20 20 6d 6f 6e 69 74 6f 72 29 0a 09 time monitor)..
5330: 09 09 20 20 28 74 61 73 6b 73 3a 6d 6f 6e 69 74 .. (tasks:monit
5340: 6f 72 2d 67 65 74 2d 6c 61 73 74 5f 75 70 64 61 or-get-last_upda
5350: 74 65 20 6d 6f 6e 69 74 6f 72 29 0a 09 09 09 20 te monitor)....
5360: 20 28 74 61 73 6b 73 3a 6d 6f 6e 69 74 6f 72 2d (tasks:monitor-
5370: 67 65 74 2d 68 6f 73 74 6e 61 6d 65 20 20 20 20 get-hostname
5380: 6d 6f 6e 69 74 6f 72 29 0a 09 09 09 20 20 28 74 monitor).... (t
5390: 61 73 6b 73 3a 6d 6f 6e 69 74 6f 72 2d 67 65 74 asks:monitor-get
53a0: 2d 75 73 65 72 6e 61 6d 65 20 20 20 20 6d 6f 6e -username mon
53b0: 69 74 6f 72 29 29 29 0a 09 09 6d 6f 6e 69 74 6f itor)))...monito
53c0: 72 73 29 0a 09 20 20 20 22 5c 6e 22 29 29 29 29 rs).. "\n"))))
53d0: 0a 20 20 20 0a 3b 3b 20 75 70 64 61 74 65 20 74 . .;; update t
53e0: 68 65 20 6c 61 73 74 5f 75 70 64 61 74 65 20 66 he last_update f
53f0: 69 65 6c 64 20 77 69 74 68 20 74 68 65 20 63 75 ield with the cu
5400: 72 72 65 6e 74 20 74 69 6d 65 20 61 6e 64 0a 3b rrent time and.;
5410: 3b 20 69 66 20 61 6e 79 20 6d 6f 6e 69 74 6f 72 ; if any monitor
5420: 73 20 61 70 70 65 61 72 20 64 65 61 64 2c 20 72 s appear dead, r
5430: 65 6d 6f 76 65 20 74 68 65 6d 0a 28 64 65 66 69 emove them.(defi
5440: 6e 65 20 28 74 61 73 6b 73 3a 6d 6f 6e 69 74 6f ne (tasks:monito
5450: 72 73 2d 75 70 64 61 74 65 20 6d 64 62 29 0a 20 rs-update mdb).
5460: 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 (sqlite3:execut
5470: 65 20 6d 64 62 20 22 55 50 44 41 54 45 20 6d 6f e mdb "UPDATE mo
5480: 6e 69 74 6f 72 73 20 53 45 54 20 6c 61 73 74 5f nitors SET last_
5490: 75 70 64 61 74 65 3d 73 74 72 66 74 69 6d 65 28 update=strftime(
54a0: 27 25 73 27 2c 27 6e 6f 77 27 29 20 57 48 45 52 '%s','now') WHER
54b0: 45 20 70 69 64 3d 3f 20 41 4e 44 20 68 6f 73 74 E pid=? AND host
54c0: 6e 61 6d 65 3d 3f 3b 22 0a 09 09 09 20 20 28 63 name=?;".... (c
54d0: 75 72 72 65 6e 74 2d 70 72 6f 63 65 73 73 2d 69 urrent-process-i
54e0: 64 29 0a 09 09 09 20 20 28 67 65 74 2d 68 6f 73 d).... (get-hos
54f0: 74 2d 6e 61 6d 65 29 29 0a 20 20 28 6c 65 74 20 t-name)). (let
5500: 28 28 64 65 61 64 6c 69 73 74 20 27 28 29 29 29 ((deadlist '()))
5510: 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f . (sqlite3:fo
5520: 72 2d 65 61 63 68 2d 72 6f 77 0a 20 20 20 20 20 r-each-row.
5530: 28 6c 61 6d 62 64 61 20 28 69 64 20 70 69 64 20 (lambda (id pid
5540: 68 6f 73 74 20 6c 61 73 74 2d 75 70 64 61 74 65 host last-update
5550: 20 64 65 6c 74 61 29 0a 20 20 20 20 20 20 20 28 delta). (
5560: 70 72 69 6e 74 20 22 47 6f 69 6e 67 20 74 6f 20 print "Going to
5570: 64 65 6c 65 74 65 20 73 74 61 6c 65 20 72 65 63 delete stale rec
5580: 6f 72 64 20 66 6f 72 20 6d 6f 6e 69 74 6f 72 20 ord for monitor
5590: 77 69 74 68 20 70 69 64 20 22 20 70 69 64 20 22 with pid " pid "
55a0: 20 6f 6e 20 68 6f 73 74 20 22 20 68 6f 73 74 20 on host " host
55b0: 22 20 6c 61 73 74 20 75 70 64 61 74 65 64 20 22 " last updated "
55c0: 20 64 65 6c 74 61 20 22 20 73 65 63 6f 6e 64 73 delta " seconds
55d0: 20 61 67 6f 22 29 0a 20 20 20 20 20 20 20 28 73 ago"). (s
55e0: 65 74 21 20 64 65 61 64 6c 69 73 74 20 28 63 6f et! deadlist (co
55f0: 6e 73 20 69 64 20 64 65 61 64 6c 69 73 74 29 29 ns id deadlist))
5600: 29 0a 20 20 20 20 20 6d 64 62 20 0a 20 20 20 20 ). mdb .
5610: 20 22 53 45 4c 45 43 54 20 69 64 2c 70 69 64 2c "SELECT id,pid,
5620: 68 6f 73 74 6e 61 6d 65 2c 6c 61 73 74 5f 75 70 hostname,last_up
5630: 64 61 74 65 2c 73 74 72 66 74 69 6d 65 28 27 25 date,strftime('%
5640: 73 27 2c 27 6e 6f 77 27 29 2d 6c 61 73 74 5f 75 s','now')-last_u
5650: 70 64 61 74 65 20 41 53 20 64 65 6c 74 61 20 46 pdate AS delta F
5660: 52 4f 4d 20 6d 6f 6e 69 74 6f 72 73 20 57 48 45 ROM monitors WHE
5670: 52 45 20 64 65 6c 74 61 20 3e 20 37 30 30 3b 22 RE delta > 700;"
5680: 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 ). (sqlite3:e
5690: 78 65 63 75 74 65 20 6d 64 62 20 28 63 6f 6e 63 xecute mdb (conc
56a0: 20 22 44 45 4c 45 54 45 20 46 52 4f 4d 20 6d 6f "DELETE FROM mo
56b0: 6e 69 74 6f 72 73 20 57 48 45 52 45 20 69 64 20 nitors WHERE id
56c0: 49 4e 20 28 27 22 20 28 73 74 72 69 6e 67 2d 69 IN ('" (string-i
56d0: 6e 74 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 ntersperse (map
56e0: 63 6f 6e 63 20 64 65 61 64 6c 69 73 74 29 20 22 conc deadlist) "
56f0: 27 2c 27 22 29 20 22 27 29 3b 22 29 29 29 0a 20 ','") "');"))).
5700: 20 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 61 73 )..(define (tas
5710: 6b 73 3a 72 65 6d 6f 76 65 2d 6d 6f 6e 69 74 6f ks:remove-monito
5720: 72 2d 72 65 63 6f 72 64 20 6d 64 62 29 0a 20 20 r-record mdb).
5730: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
5740: 20 6d 64 62 20 22 44 45 4c 45 54 45 20 46 52 4f mdb "DELETE FRO
5750: 4d 20 6d 6f 6e 69 74 6f 72 73 20 57 48 45 52 45 M monitors WHERE
5760: 20 70 69 64 3d 3f 20 41 4e 44 20 68 6f 73 74 6e pid=? AND hostn
5770: 61 6d 65 3d 3f 3b 22 0a 09 09 20 20 20 28 63 75 ame=?;"... (cu
5780: 72 72 65 6e 74 2d 70 72 6f 63 65 73 73 2d 69 64 rrent-process-id
5790: 29 0a 09 09 20 20 20 28 67 65 74 2d 68 6f 73 74 )... (get-host
57a0: 2d 6e 61 6d 65 29 29 29 0a 0a 28 64 65 66 69 6e -name)))..(defin
57b0: 65 20 28 74 61 73 6b 73 3a 73 65 74 2d 73 74 61 e (tasks:set-sta
57c0: 74 65 20 6d 64 62 20 74 61 73 6b 2d 69 64 20 73 te mdb task-id s
57d0: 74 61 74 65 29 0a 20 20 28 73 71 6c 69 74 65 33 tate). (sqlite3
57e0: 3a 65 78 65 63 75 74 65 20 6d 64 62 20 22 55 50 :execute mdb "UP
57f0: 44 41 54 45 20 74 61 73 6b 73 5f 71 75 65 75 65 DATE tasks_queue
5800: 20 53 45 54 20 73 74 61 74 65 3d 3f 20 57 48 45 SET state=? WHE
5810: 52 45 20 69 64 3d 3f 3b 22 20 0a 09 09 20 20 20 RE id=?;" ...
5820: 73 74 61 74 65 20 0a 09 09 20 20 20 74 61 73 6b state ... task
5830: 2d 69 64 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d -id))..;;=======
5840: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5850: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5860: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5870: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
5880: 3b 3b 20 54 68 65 20 72 6f 75 74 69 6e 65 73 20 ;; The routines
5890: 74 6f 20 70 72 6f 63 65 73 73 20 74 61 73 6b 73 to process tasks
58a0: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
58b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
58c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
58d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
58e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 4e 4f =========..;; NO
58f0: 54 45 3a 20 49 74 20 6d 69 67 68 74 20 62 65 20 TE: It might be
5900: 67 6f 6f 64 20 74 6f 20 61 64 64 20 6f 6e 65 20 good to add one
5910: 6d 6f 72 65 20 6c 61 79 65 72 20 6f 66 20 63 68 more layer of ch
5920: 65 63 6b 69 6e 67 20 74 6f 20 65 6e 73 75 72 65 ecking to ensure
5930: 0a 3b 3b 20 20 20 20 20 20 20 74 68 61 74 20 6e .;; that n
5940: 6f 20 74 61 73 6b 20 67 65 74 73 20 72 75 6e 20 o task gets run
5950: 69 6e 20 70 61 72 61 6c 6c 65 6c 2e 0a 0a 28 64 in parallel...(d
5960: 65 66 69 6e 65 20 28 74 61 73 6b 73 3a 73 74 61 efine (tasks:sta
5970: 72 74 2d 72 75 6e 20 64 62 20 6d 64 62 20 74 61 rt-run db mdb ta
5980: 73 6b 29 0a 20 20 28 6c 65 74 20 28 28 66 6c 61 sk). (let ((fla
5990: 67 73 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 gs (make-hash-ta
59a0: 62 6c 65 29 29 29 0a 20 20 20 20 28 68 61 73 68 ble))). (hash
59b0: 2d 74 61 62 6c 65 2d 73 65 74 21 20 66 6c 61 67 -table-set! flag
59c0: 73 20 22 2d 72 65 72 75 6e 22 20 22 4e 4f 54 5f s "-rerun" "NOT_
59d0: 53 54 41 52 54 45 44 22 29 0a 20 20 20 20 28 69 STARTED"). (i
59e0: 66 20 28 6e 6f 74 20 28 73 74 72 69 6e 67 3d 3f f (not (string=?
59f0: 20 28 74 61 73 6b 73 3a 74 61 73 6b 2d 67 65 74 (tasks:task-get
5a00: 2d 70 61 72 61 6d 73 20 74 61 73 6b 29 20 22 22 -params task) ""
5a10: 29 29 0a 09 28 68 61 73 68 2d 74 61 62 6c 65 2d ))..(hash-table-
5a20: 73 65 74 21 20 66 6c 61 67 73 20 22 2d 73 65 74 set! flags "-set
5a30: 76 61 72 73 22 20 28 74 61 73 6b 73 3a 74 61 73 vars" (tasks:tas
5a40: 6b 2d 67 65 74 2d 70 61 72 61 6d 73 20 74 61 73 k-get-params tas
5a50: 6b 29 29 29 0a 20 20 20 20 28 70 72 69 6e 74 20 k))). (print
5a60: 22 53 74 61 72 74 69 6e 67 20 72 75 6e 20 22 20 "Starting run "
5a70: 74 61 73 6b 29 0a 20 20 20 20 3b 3b 20 73 69 6c task). ;; sil
5a80: 6c 79 6e 65 73 73 2c 20 6a 75 73 74 20 63 61 6c lyness, just cal
5a90: 6c 20 74 68 65 20 64 61 6d 6e 20 72 6f 75 74 69 l the damn routi
5aa0: 6e 65 20 77 69 74 68 20 74 68 65 20 74 61 73 6b ne with the task
5ab0: 20 76 65 63 74 6f 72 20 61 6e 64 20 62 65 20 64 vector and be d
5ac0: 6f 6e 65 20 77 69 74 68 20 69 74 2e 20 46 49 58 one with it. FIX
5ad0: 4d 45 20 53 4f 4d 45 44 41 59 0a 20 20 20 20 28 ME SOMEDAY. (
5ae0: 72 75 6e 73 3a 72 75 6e 2d 74 65 73 74 73 20 64 runs:run-tests d
5af0: 62 0a 09 09 20 20 20 20 28 74 61 73 6b 73 3a 74 b... (tasks:t
5b00: 61 73 6b 2d 67 65 74 2d 74 61 72 67 65 74 20 74 ask-get-target t
5b10: 61 73 6b 29 0a 09 09 20 20 20 20 28 74 61 73 6b ask)... (task
5b20: 73 3a 74 61 73 6b 2d 67 65 74 2d 6e 61 6d 65 20 s:task-get-name
5b30: 20 20 74 61 73 6b 29 0a 09 09 20 20 20 20 28 74 task)... (t
5b40: 61 73 6b 73 3a 74 61 73 6b 2d 67 65 74 2d 74 65 asks:task-get-te
5b50: 73 74 20 20 20 74 61 73 6b 29 0a 09 09 20 20 20 st task)...
5b60: 20 28 74 61 73 6b 73 3a 74 61 73 6b 2d 67 65 74 (tasks:task-get
5b70: 2d 69 74 65 6d 20 20 20 74 61 73 6b 29 0a 09 09 -item task)...
5b80: 20 20 20 20 28 74 61 73 6b 73 3a 74 61 73 6b 2d (tasks:task-
5b90: 67 65 74 2d 6f 77 6e 65 72 20 20 74 61 73 6b 29 get-owner task)
5ba0: 0a 09 09 20 20 20 20 66 6c 61 67 73 29 0a 20 20 ... flags).
5bb0: 20 20 28 74 61 73 6b 73 3a 73 65 74 2d 73 74 61 (tasks:set-sta
5bc0: 74 65 20 6d 64 62 20 28 74 61 73 6b 73 3a 74 61 te mdb (tasks:ta
5bd0: 73 6b 2d 67 65 74 2d 69 64 20 74 61 73 6b 29 20 sk-get-id task)
5be0: 22 77 61 69 74 69 6e 67 22 29 29 29 0a 0a 28 64 "waiting")))..(d
5bf0: 65 66 69 6e 65 20 28 74 61 73 6b 73 3a 72 6f 6c efine (tasks:rol
5c00: 6c 75 70 2d 72 75 6e 73 20 64 62 20 6d 64 62 20 lup-runs db mdb
5c10: 74 61 73 6b 29 0a 20 20 28 6c 65 74 2a 20 28 28 task). (let* ((
5c20: 66 6c 61 67 73 20 28 6d 61 6b 65 2d 68 61 73 68 flags (make-hash
5c30: 2d 74 61 62 6c 65 29 29 20 0a 09 20 28 6b 65 79 -table)) .. (key
5c40: 73 20 20 28 64 62 3a 67 65 74 2d 6b 65 79 73 20 s (db:get-keys
5c50: 64 62 29 29 0a 09 20 28 6b 65 79 76 61 6c 6c 73 db)).. (keyvalls
5c60: 74 20 28 6b 65 79 73 3a 74 61 72 67 65 74 2d 3e t (keys:target->
5c70: 6b 65 79 76 61 6c 20 6b 65 79 73 20 28 74 61 73 keyval keys (tas
5c80: 6b 73 3a 74 61 73 6b 2d 67 65 74 2d 74 61 72 67 ks:task-get-targ
5c90: 65 74 20 74 61 73 6b 29 29 29 29 0a 20 20 20 20 et task)))).
5ca0: 3b 3b 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 ;; (hash-table-s
5cb0: 65 74 21 20 66 6c 61 67 73 20 22 2d 72 65 72 75 et! flags "-reru
5cc0: 6e 22 20 22 4e 4f 54 5f 53 54 41 52 54 45 44 22 n" "NOT_STARTED"
5cd0: 29 0a 20 20 20 20 28 70 72 69 6e 74 20 22 53 74 ). (print "St
5ce0: 61 72 74 69 6e 67 20 72 6f 6c 6c 75 70 20 22 20 arting rollup "
5cf0: 74 61 73 6b 29 0a 20 20 20 20 3b 3b 20 73 69 6c task). ;; sil
5d00: 6c 79 6e 65 73 73 2c 20 6a 75 73 74 20 63 61 6c lyness, just cal
5d10: 6c 20 74 68 65 20 64 61 6d 6e 20 72 6f 75 74 69 l the damn routi
5d20: 6e 65 20 77 69 74 68 20 74 68 65 20 74 61 73 6b ne with the task
5d30: 20 76 65 63 74 6f 72 20 61 6e 64 20 62 65 20 64 vector and be d
5d40: 6f 6e 65 20 77 69 74 68 20 69 74 2e 20 46 49 58 one with it. FIX
5d50: 4d 45 20 53 4f 4d 45 44 41 59 0a 20 20 20 20 28 ME SOMEDAY. (
5d60: 72 75 6e 73 3a 72 6f 6c 6c 75 70 2d 72 75 6e 20 runs:rollup-run
5d70: 64 62 0a 09 09 20 20 20 20 20 6b 65 79 73 20 0a db... keys .
5d80: 09 09 20 20 20 20 20 6b 65 79 76 61 6c 6c 73 74 .. keyvallst
5d90: 0a 09 09 20 20 20 20 20 28 74 61 73 6b 73 3a 74 ... (tasks:t
5da0: 61 73 6b 2d 67 65 74 2d 6e 61 6d 65 20 20 74 61 ask-get-name ta
5db0: 73 6b 29 0a 09 09 20 20 20 20 20 28 74 61 73 6b sk)... (task
5dc0: 73 3a 74 61 73 6b 2d 67 65 74 2d 6f 77 6e 65 72 s:task-get-owner
5dd0: 20 20 74 61 73 6b 29 29 0a 20 20 20 20 28 74 61 task)). (ta
5de0: 73 6b 73 3a 73 65 74 2d 73 74 61 74 65 20 6d 64 sks:set-state md
5df0: 62 20 28 74 61 73 6b 73 3a 74 61 73 6b 2d 67 65 b (tasks:task-ge
5e00: 74 2d 69 64 20 74 61 73 6b 29 20 22 77 61 69 74 t-id task) "wait
5e10: 69 6e 67 22 29 29 29 0a ing"))).