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 64 62 2f 6d *toppath* "/db/m
0330: 6f 6e 69 74 6f 72 2e 64 62 22 29 29 0a 09 20 28 onitor.db")).. (
0340: 65 78 69 73 74 73 20 20 20 20 20 20 20 28 66 69 exists (fi
0350: 6c 65 2d 65 78 69 73 74 73 3f 20 64 62 70 61 74 le-exists? dbpat
0360: 68 29 29 0a 09 20 28 77 72 69 74 65 2d 61 63 63 h)).. (write-acc
0370: 65 73 73 20 28 66 69 6c 65 2d 77 72 69 74 65 2d ess (file-write-
0380: 61 63 63 65 73 73 3f 20 64 62 70 61 74 68 29 29 access? dbpath))
0390: 0a 09 20 28 6d 64 62 20 20 20 20 20 20 20 20 20 .. (mdb
03a0: 20 28 73 71 6c 69 74 65 33 3a 6f 70 65 6e 2d 64 (sqlite3:open-d
03b0: 61 74 61 62 61 73 65 20 64 62 70 61 74 68 29 29 atabase dbpath))
03c0: 20 3b 3b 20 28 6e 65 76 65 72 2d 67 69 76 65 2d ;; (never-give-
03d0: 75 70 2d 6f 70 65 6e 2d 64 62 20 64 62 70 61 74 up-open-db dbpat
03e0: 68 29 29 0a 09 20 28 68 61 6e 64 6c 65 72 20 20 h)).. (handler
03f0: 20 20 20 20 28 6d 61 6b 65 2d 62 75 73 79 2d 74 (make-busy-t
0400: 69 6d 65 6f 75 74 20 33 36 30 30 30 29 29 29 0a imeout 36000))).
0410: 20 20 20 20 28 69 66 20 28 61 6e 64 20 65 78 69 (if (and exi
0420: 73 74 73 0a 09 20 20 20 20 20 28 6e 6f 74 20 77 sts.. (not w
0430: 72 69 74 65 2d 61 63 63 65 73 73 29 29 0a 09 28 rite-access))..(
0440: 73 65 74 21 20 2a 64 62 2d 77 72 69 74 65 2d 61 set! *db-write-a
0450: 63 63 65 73 73 2a 20 77 72 69 74 65 2d 61 63 63 ccess* write-acc
0460: 65 73 73 29 29 20 3b 3b 20 6f 6e 6c 79 20 75 6e ess)) ;; only un
0470: 73 65 74 20 73 6f 20 6f 74 68 65 72 20 64 62 27 set so other db'
0480: 73 20 61 6c 73 6f 20 63 61 6e 20 75 73 65 20 74 s also can use t
0490: 68 69 73 20 63 6f 6e 74 72 6f 6c 0a 20 20 20 20 his control.
04a0: 28 73 71 6c 69 74 65 33 3a 73 65 74 2d 62 75 73 (sqlite3:set-bus
04b0: 79 2d 68 61 6e 64 6c 65 72 21 20 6d 64 62 20 68 y-handler! mdb h
04c0: 61 6e 64 6c 65 72 29 0a 20 20 20 20 28 73 71 6c andler). (sql
04d0: 69 74 65 33 3a 65 78 65 63 75 74 65 20 6d 64 62 ite3:execute mdb
04e0: 20 28 63 6f 6e 63 20 22 50 52 41 47 4d 41 20 73 (conc "PRAGMA s
04f0: 79 6e 63 68 72 6f 6e 6f 75 73 20 3d 20 30 3b 22 ynchronous = 0;"
0500: 29 29 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 )). (if (not
0510: 65 78 69 73 74 73 29 0a 09 28 62 65 67 69 6e 0a exists)..(begin.
0520: 09 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 . (sqlite3:exec
0530: 75 74 65 20 6d 64 62 20 22 43 52 45 41 54 45 20 ute mdb "CREATE
0540: 54 41 42 4c 45 20 49 46 20 4e 4f 54 20 45 58 49 TABLE IF NOT EXI
0550: 53 54 53 20 74 61 73 6b 73 5f 71 75 65 75 65 20 STS tasks_queue
0560: 28 69 64 20 49 4e 54 45 47 45 52 20 50 52 49 4d (id INTEGER PRIM
0570: 41 52 59 20 4b 45 59 2c 0a 20 20 20 20 20 20 20 ARY 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 20 20 20 61 63 74 69 6f 6e 20 action
05a0: 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 27 2c TEXT DEFAULT '',
05b0: 0a 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 20 20
05d0: 20 6f 77 6e 65 72 20 54 45 58 54 2c 0a 20 20 20 owner 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 20 20 20 73 74 61 sta
0600: 74 65 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 te TEXT DEFAULT
0610: 27 6e 65 77 27 2c 0a 20 20 20 20 20 20 20 20 20 'new',.
0620: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0630: 20 20 20 20 20 20 20 74 61 72 67 65 74 20 54 45 target TE
0640: 58 54 20 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 XT 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 20 20 20 6e n
0670: 61 6d 65 20 54 45 58 54 20 44 45 46 41 55 4c 54 ame TEXT DEFAULT
0680: 20 27 27 2c 0a 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 20 20 20 74 65 73 74 70 61 74 74 20 54 45 testpatt TE
06b0: 58 54 20 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 XT DEFAULT '',.
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 20 20 20 20 20 20 20 6b k
06e0: 65 79 6c 6f 63 6b 20 54 45 58 54 2c 0a 20 20 20 eylock TEXT,.
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 70 61 72 par
0710: 61 6d 73 20 54 45 58 54 2c 0a 20 20 20 20 20 20 ams 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 63 72 65 61 74 69 creati
0740: 6f 6e 5f 74 69 6d 65 20 54 49 4d 45 53 54 41 4d on_time TIMESTAM
0750: 50 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 P,.
0760: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0770: 20 20 20 65 78 65 63 75 74 69 6f 6e 5f 74 69 6d execution_tim
0780: 65 20 54 49 4d 45 53 54 41 4d 50 29 3b 22 29 0a e TIMESTAMP);").
0790: 09 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 . (sqlite3:exec
07a0: 75 74 65 20 6d 64 62 20 22 43 52 45 41 54 45 20 ute mdb "CREATE
07b0: 54 41 42 4c 45 20 49 46 20 4e 4f 54 20 45 58 49 TABLE IF NOT EXI
07c0: 53 54 53 20 6d 6f 6e 69 74 6f 72 73 20 28 69 64 STS monitors (id
07d0: 20 49 4e 54 45 47 45 52 20 50 52 49 4d 41 52 59 INTEGER PRIMARY
07e0: 20 4b 45 59 2c 0a 20 20 20 20 20 20 20 20 20 20 KEY,.
07f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0800: 20 20 20 20 20 20 70 69 64 20 49 4e 54 45 47 45 pid INTEGE
0810: 52 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 R,.
0820: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0830: 20 20 20 73 74 61 72 74 5f 74 69 6d 65 20 54 49 start_time TI
0840: 4d 45 53 54 41 4d 50 2c 0a 20 20 20 20 20 20 20 MESTAMP,.
0850: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0860: 20 20 20 20 20 20 20 20 20 6c 61 73 74 5f 75 70 last_up
0870: 64 61 74 65 20 54 49 4d 45 53 54 41 4d 50 2c 0a date TIMESTAMP,.
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 20 20 20 20 20 20 20 20
08a0: 68 6f 73 74 6e 61 6d 65 20 54 45 58 54 2c 0a 20 hostname TEXT,.
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 75 u
08d0: 73 65 72 6e 61 6d 65 20 54 45 58 54 2c 0a 20 20 sername 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 43 4f 4e CON
0900: 53 54 52 41 49 4e 54 20 6d 6f 6e 69 74 6f 72 73 STRAINT monitors
0910: 5f 63 6f 6e 73 74 72 61 69 6e 74 20 55 4e 49 51 _constraint UNIQ
0920: 55 45 20 28 70 69 64 2c 68 6f 73 74 6e 61 6d 65 UE (pid,hostname
0930: 29 29 3b 22 29 0a 09 20 20 28 73 71 6c 69 74 65 ));").. (sqlite
0940: 33 3a 65 78 65 63 75 74 65 20 6d 64 62 20 22 43 3:execute mdb "C
0950: 52 45 41 54 45 20 54 41 42 4c 45 20 49 46 20 4e REATE TABLE IF N
0960: 4f 54 20 45 58 49 53 54 53 20 73 65 72 76 65 72 OT EXISTS server
0970: 73 20 28 69 64 20 49 4e 54 45 47 45 52 20 50 52 s (id INTEGER PR
0980: 49 4d 41 52 59 20 4b 45 59 2c 0a 20 20 20 20 20 IMARY KEY,.
0990: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
09a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 70 69 64 pid
09b0: 20 49 4e 54 45 47 45 52 2c 0a 20 20 20 20 20 20 INTEGER,.
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 69 6e 74 65 inte
09e0: 72 66 61 63 65 20 54 45 58 54 2c 0a 20 20 20 20 rface TEXT,.
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 20 20 20 68 6f ho
0a10: 73 74 6e 61 6d 65 20 54 45 58 54 2c 0a 20 20 20 stname 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 20 20 70 p
0a40: 6f 72 74 20 49 4e 54 45 47 45 52 2c 0a 20 20 20 ort INTEGER,.
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 20 70 p
0a70: 75 62 70 6f 72 74 20 49 4e 54 45 47 45 52 2c 0a ubport 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 20 20
0aa0: 20 20 73 74 61 72 74 5f 74 69 6d 65 20 54 49 4d start_time TIM
0ab0: 45 53 54 41 4d 50 2c 0a 20 20 20 20 20 20 20 20 ESTAMP,.
0ac0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ad0: 20 20 20 20 20 20 20 20 20 20 70 72 69 6f 72 69 priori
0ae0: 74 79 20 49 4e 54 45 47 45 52 2c 0a 20 20 20 20 ty INTEGER,.
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 20 20 20 20 20 73 74 st
0b10: 61 74 65 20 54 45 58 54 2c 0a 20 20 20 20 20 20 ate TEXT,.
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 6d 74 5f 76 mt_v
0b40: 65 72 73 69 6f 6e 20 54 45 58 54 2c 0a 20 20 20 ersion 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 20 20 20 20 68 h
0b70: 65 61 72 74 62 65 61 74 20 54 49 4d 45 53 54 41 eartbeat TIMESTA
0b80: 4d 50 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 MP,.
0b90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ba0: 20 20 20 20 20 20 74 72 61 6e 73 70 6f 72 74 20 transport
0bb0: 54 45 58 54 2c 0a 20 20 20 20 20 20 20 20 20 20 TEXT,.
0bc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0bd0: 20 20 20 20 20 20 20 20 72 75 6e 5f 69 64 20 49 run_id I
0be0: 4e 54 45 47 45 52 29 3b 22 29 0a 3b 3b 20 20 20 NTEGER);").;;
0bf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0c00: 20 20 20 20 20 20 20 20 20 20 20 20 43 4f 4e 53 CONS
0c10: 54 52 41 49 4e 54 20 73 65 72 76 65 72 73 5f 63 TRAINT servers_c
0c20: 6f 6e 73 74 72 61 69 6e 74 20 55 4e 49 51 55 45 onstraint UNIQUE
0c30: 20 28 70 69 64 2c 68 6f 73 74 6e 61 6d 65 2c 70 (pid,hostname,p
0c40: 6f 72 74 29 29 3b 22 29 0a 09 20 20 28 73 71 6c ort));").. (sql
0c50: 69 74 65 33 3a 65 78 65 63 75 74 65 20 6d 64 62 ite3:execute mdb
0c60: 20 22 43 52 45 41 54 45 20 54 41 42 4c 45 20 49 "CREATE TABLE I
0c70: 46 20 4e 4f 54 20 45 58 49 53 54 53 20 63 6c 69 F NOT EXISTS cli
0c80: 65 6e 74 73 20 28 69 64 20 49 4e 54 45 47 45 52 ents (id INTEGER
0c90: 20 50 52 49 4d 41 52 59 20 4b 45 59 2c 0a 20 20 PRIMARY 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 20 20 20 20 20 20 20 20
0cc0: 73 65 72 76 65 72 5f 69 64 20 49 4e 54 45 47 45 server_id INTEGE
0cd0: 52 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 R,.
0ce0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0cf0: 20 20 20 20 20 70 69 64 20 49 4e 54 45 47 45 52 pid INTEGER
0d00: 2c 0a 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 20 20 20 20
0d20: 20 20 20 20 68 6f 73 74 6e 61 6d 65 20 54 45 58 hostname TEX
0d30: 54 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 T,.
0d40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d50: 20 20 20 20 20 63 6d 64 6c 69 6e 65 20 54 45 58 cmdline TEX
0d60: 54 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 T,.
0d70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d80: 20 20 20 20 20 6c 6f 67 69 6e 5f 74 69 6d 65 20 login_time
0d90: 54 49 4d 45 53 54 41 4d 50 2c 0a 20 20 20 20 20 TIMESTAMP,.
0da0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0db0: 20 20 20 20 20 20 20 20 20 20 20 20 20 6c 6f 67 log
0dc0: 6f 75 74 5f 74 69 6d 65 20 54 49 4d 45 53 54 41 out_time TIMESTA
0dd0: 4d 50 20 44 45 46 41 55 4c 54 20 2d 31 2c 0a 20 MP DEFAULT -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 20 20 20 20 20 20 20 20 43 C
0e00: 4f 4e 53 54 52 41 49 4e 54 20 63 6c 69 65 6e 74 ONSTRAINT client
0e10: 73 5f 63 6f 6e 73 74 72 61 69 6e 74 20 55 4e 49 s_constraint UNI
0e20: 51 55 45 20 28 70 69 64 2c 68 6f 73 74 6e 61 6d QUE (pid,hostnam
0e30: 65 29 29 3b 22 29 0a 20 20 20 20 20 20 20 20 20 e));").
0e40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e50: 20 20 20 20 20 20 20 20 20 0a 09 20 20 29 29 0a .. )).
0e60: 20 20 20 20 6d 64 62 29 29 0a 20 20 20 20 0a 3b mdb)). .;
0e70: 3b 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 3d ================
0eb0: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 53 65 72 76 65 =======.;; Serve
0ec0: 72 20 61 6e 64 20 63 6c 69 65 6e 74 20 6d 61 6e r and client man
0ed0: 61 67 65 6d 65 6e 74 0a 3b 3b 3d 3d 3d 3d 3d 3d agement.;;======
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 3d 3d 3d 3d 3d 3d 3d 3d ================
0f20: 0a 0a 3b 3b 20 6d 61 6b 65 2d 76 65 63 74 6f 72 ..;; make-vector
0f30: 2d 72 65 63 6f 72 64 20 74 61 73 6b 73 20 68 6f -record tasks ho
0f40: 73 74 69 6e 66 6f 20 69 64 20 69 6e 74 65 72 66 stinfo id interf
0f50: 61 63 65 20 70 6f 72 74 20 70 75 62 70 6f 72 74 ace port pubport
0f60: 20 74 72 61 6e 73 70 6f 72 74 20 70 69 64 20 68 transport pid h
0f70: 6f 73 74 6e 61 6d 65 0a 28 64 65 66 69 6e 65 20 ostname.(define
0f80: 28 74 61 73 6b 73 3a 68 6f 73 74 69 6e 66 6f 2d (tasks:hostinfo-
0f90: 67 65 74 2d 69 64 20 20 20 20 20 20 20 20 20 20 get-id
0fa0: 76 65 63 29 20 20 20 20 28 76 65 63 74 6f 72 2d vec) (vector-
0fb0: 72 65 66 20 20 76 65 63 20 30 29 29 0a 28 64 65 ref vec 0)).(de
0fc0: 66 69 6e 65 20 28 74 61 73 6b 73 3a 68 6f 73 74 fine (tasks:host
0fd0: 69 6e 66 6f 2d 67 65 74 2d 69 6e 74 65 72 66 61 info-get-interfa
0fe0: 63 65 20 20 20 76 65 63 29 20 20 20 20 28 76 65 ce vec) (ve
0ff0: 63 74 6f 72 2d 72 65 66 20 20 76 65 63 20 31 29 ctor-ref vec 1)
1000: 29 0a 28 64 65 66 69 6e 65 20 28 74 61 73 6b 73 ).(define (tasks
1010: 3a 68 6f 73 74 69 6e 66 6f 2d 67 65 74 2d 70 6f :hostinfo-get-po
1020: 72 74 20 20 20 20 20 20 20 20 76 65 63 29 20 20 rt vec)
1030: 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 20 76 (vector-ref v
1040: 65 63 20 32 29 29 0a 28 64 65 66 69 6e 65 20 28 ec 2)).(define (
1050: 74 61 73 6b 73 3a 68 6f 73 74 69 6e 66 6f 2d 67 tasks:hostinfo-g
1060: 65 74 2d 70 75 62 70 6f 72 74 20 20 20 20 20 76 et-pubport v
1070: 65 63 29 20 20 20 20 28 76 65 63 74 6f 72 2d 72 ec) (vector-r
1080: 65 66 20 20 76 65 63 20 33 29 29 0a 28 64 65 66 ef vec 3)).(def
1090: 69 6e 65 20 28 74 61 73 6b 73 3a 68 6f 73 74 69 ine (tasks:hosti
10a0: 6e 66 6f 2d 67 65 74 2d 74 72 61 6e 73 70 6f 72 nfo-get-transpor
10b0: 74 20 20 20 76 65 63 29 20 20 20 20 28 76 65 63 t vec) (vec
10c0: 74 6f 72 2d 72 65 66 20 20 76 65 63 20 34 29 29 tor-ref vec 4))
10d0: 0a 28 64 65 66 69 6e 65 20 28 74 61 73 6b 73 3a .(define (tasks:
10e0: 68 6f 73 74 69 6e 66 6f 2d 67 65 74 2d 70 69 64 hostinfo-get-pid
10f0: 20 20 20 20 20 20 20 20 20 76 65 63 29 20 20 20 vec)
1100: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 20 76 65 (vector-ref ve
1110: 63 20 35 29 29 0a 28 64 65 66 69 6e 65 20 28 74 c 5)).(define (t
1120: 61 73 6b 73 3a 68 6f 73 74 69 6e 66 6f 2d 67 65 asks:hostinfo-ge
1130: 74 2d 68 6f 73 74 6e 61 6d 65 20 20 20 20 76 65 t-hostname ve
1140: 63 29 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 c) (vector-re
1150: 66 20 20 76 65 63 20 36 29 29 0a 0a 28 64 65 66 f vec 6))..(def
1160: 69 6e 65 20 28 74 61 73 6b 73 3a 73 65 72 76 65 ine (tasks:serve
1170: 72 2d 6c 6f 63 6b 2d 73 6c 6f 74 20 6d 64 62 20 r-lock-slot mdb
1180: 72 75 6e 2d 69 64 29 0a 20 20 28 74 61 73 6b 73 run-id). (tasks
1190: 3a 73 65 72 76 65 72 2d 63 6c 65 61 6e 2d 6f 75 :server-clean-ou
11a0: 74 2d 6f 6c 64 2d 72 65 63 6f 72 64 73 2d 66 6f t-old-records-fo
11b0: 72 2d 72 75 6e 2d 69 64 20 6d 64 62 20 72 75 6e r-run-id mdb run
11c0: 2d 69 64 29 0a 20 20 28 69 66 20 28 3c 20 28 74 -id). (if (< (t
11d0: 61 73 6b 73 3a 6e 75 6d 2d 69 6e 2d 61 76 61 69 asks:num-in-avai
11e0: 6c 61 62 6c 65 2d 73 74 61 74 65 20 6d 64 62 20 lable-state mdb
11f0: 72 75 6e 2d 69 64 29 20 34 29 0a 20 20 20 20 20 run-id) 4).
1200: 20 28 62 65 67 69 6e 20 0a 09 28 74 61 73 6b 73 (begin ..(tasks
1210: 3a 73 65 72 76 65 72 2d 73 65 74 2d 61 76 61 69 :server-set-avai
1220: 6c 61 62 6c 65 20 6d 64 62 20 72 75 6e 2d 69 64 lable mdb run-id
1230: 29 0a 09 28 74 68 72 65 61 64 2d 73 6c 65 65 70 )..(thread-sleep
1240: 21 20 30 2e 32 29 20 3b 3b 20 54 72 79 20 72 65 ! 0.2) ;; Try re
1250: 6d 6f 76 69 6e 67 20 74 68 69 73 2e 20 49 74 20 moving this. It
1260: 6d 61 79 20 6e 6f 74 20 62 65 20 6e 65 65 64 65 may not be neede
1270: 64 2e 0a 09 28 74 61 73 6b 73 3a 73 65 72 76 65 d...(tasks:serve
1280: 72 2d 61 6d 2d 69 2d 74 68 65 2d 73 65 72 76 65 r-am-i-the-serve
1290: 72 3f 20 6d 64 62 20 72 75 6e 2d 69 64 29 29 0a r? mdb run-id)).
12a0: 20 20 20 20 20 20 23 66 29 29 0a 09 0a 3b 3b 20 #f))...;;
12b0: 72 65 67 69 73 74 65 72 20 74 68 61 74 20 74 68 register that th
12c0: 69 73 20 73 65 72 76 65 72 20 6d 61 79 20 63 6f is server may co
12d0: 6d 65 20 6f 6e 6c 69 6e 65 20 28 66 69 72 73 74 me online (first
12e0: 20 74 6f 20 72 65 67 69 73 74 65 72 20 67 6f 65 to register goe
12f0: 73 20 74 68 6f 75 67 68 20 77 69 74 68 20 74 68 s though with th
1300: 65 20 70 72 6f 63 65 73 73 29 0a 28 64 65 66 69 e process).(defi
1310: 6e 65 20 28 74 61 73 6b 73 3a 73 65 72 76 65 72 ne (tasks:server
1320: 2d 73 65 74 2d 61 76 61 69 6c 61 62 6c 65 20 6d -set-available m
1330: 64 62 20 72 75 6e 2d 69 64 29 0a 20 20 28 73 71 db run-id). (sq
1340: 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 0a 20 lite3:execute .
1350: 20 20 6d 64 62 20 0a 20 20 20 22 49 4e 53 45 52 mdb . "INSER
1360: 54 20 49 4e 54 4f 20 73 65 72 76 65 72 73 20 28 T INTO servers (
1370: 70 69 64 2c 68 6f 73 74 6e 61 6d 65 2c 70 6f 72 pid,hostname,por
1380: 74 2c 70 75 62 70 6f 72 74 2c 73 74 61 72 74 5f t,pubport,start_
1390: 74 69 6d 65 2c 20 20 20 20 20 20 70 72 69 6f 72 time, prior
13a0: 69 74 79 2c 73 74 61 74 65 2c 6d 74 5f 76 65 72 ity,state,mt_ver
13b0: 73 69 6f 6e 2c 68 65 61 72 74 62 65 61 74 2c 20 sion,heartbeat,
13c0: 20 20 69 6e 74 65 72 66 61 63 65 2c 74 72 61 6e interface,tran
13d0: 73 70 6f 72 74 2c 72 75 6e 5f 69 64 29 0a 20 20 sport,run_id).
13e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13f0: 20 56 41 4c 55 45 53 28 3f 2c 20 3f 2c 20 20 20 VALUES(?, ?,
1400: 20 20 20 20 3f 2c 20 20 20 3f 2c 20 73 74 72 66 ?, ?, strf
1410: 74 69 6d 65 28 27 25 73 27 2c 27 6e 6f 77 27 29 time('%s','now')
1420: 2c 20 3f 2c 20 20 20 20 20 20 20 3f 2c 20 20 20 , ?, ?,
1430: 20 3f 2c 2d 31 2c 3f 2c 20 20 20 20 20 20 20 20 ?,-1,?,
1440: 3f 2c 20 20 20 20 20 20 20 20 3f 29 3b 22 0a 20 ?, ?);".
1450: 20 20 28 63 75 72 72 65 6e 74 2d 70 72 6f 63 65 (current-proce
1460: 73 73 2d 69 64 29 20 20 20 20 20 20 20 3b 3b 20 ss-id) ;;
1470: 70 69 64 0a 20 20 20 28 67 65 74 2d 68 6f 73 74 pid. (get-host
1480: 2d 6e 61 6d 65 29 20 20 20 20 20 20 20 20 20 20 -name)
1490: 20 20 3b 3b 20 68 6f 73 74 6e 61 6d 65 0a 20 20 ;; hostname.
14a0: 20 2d 31 20 20 20 20 20 20 20 20 20 20 20 20 20 -1
14b0: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 70 ;; p
14c0: 6f 72 74 0a 20 20 20 2d 31 20 20 20 20 20 20 20 ort. -1
14d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14e0: 20 20 3b 3b 20 70 75 62 70 6f 72 74 0a 20 20 20 ;; pubport.
14f0: 28 72 61 6e 64 6f 6d 20 31 30 30 30 29 20 20 20 (random 1000)
1500: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 70 72 ;; pr
1510: 69 6f 72 69 74 79 20 28 75 73 65 64 20 61 20 74 iority (used a t
1520: 69 65 62 72 65 61 6b 65 72 20 6f 6e 20 67 65 74 iebreaker on get
1530: 2d 61 76 61 69 6c 61 62 6c 65 29 0a 20 20 20 22 -available). "
1540: 61 76 61 69 6c 61 62 6c 65 22 20 20 20 20 20 20 available"
1550: 20 20 20 20 20 20 20 20 20 20 3b 3b 20 73 74 61 ;; sta
1560: 74 65 0a 20 20 20 28 63 6f 6d 6d 6f 6e 3a 76 65 te. (common:ve
1570: 72 73 69 6f 6e 2d 73 69 67 6e 61 74 75 72 65 29 rsion-signature)
1580: 20 3b 3b 20 6d 74 5f 76 65 72 73 69 6f 6e 0a 20 ;; mt_version.
1590: 20 20 2d 31 20 20 20 20 20 20 20 20 20 20 20 20 -1
15a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;;
15b0: 69 6e 74 65 72 66 61 63 65 0a 20 20 20 22 68 74 interface. "ht
15c0: 74 70 22 20 20 20 20 20 20 20 20 20 20 20 20 20 tp"
15d0: 20 20 20 20 20 20 20 20 3b 3b 20 74 72 61 6e 73 ;; trans
15e0: 70 6f 72 74 0a 20 20 20 72 75 6e 2d 69 64 0a 20 port. run-id.
15f0: 20 20 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 ))..(define (t
1600: 61 73 6b 73 3a 6e 75 6d 2d 69 6e 2d 61 76 61 69 asks:num-in-avai
1610: 6c 61 62 6c 65 2d 73 74 61 74 65 20 6d 64 62 20 lable-state mdb
1620: 72 75 6e 2d 69 64 29 0a 20 20 28 6c 65 74 20 28 run-id). (let (
1630: 28 72 65 73 20 30 29 29 0a 20 20 20 20 28 73 71 (res 0)). (sq
1640: 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 lite3:for-each-r
1650: 6f 77 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 ow. (lambda
1660: 28 6e 75 6d 2d 69 6e 2d 71 75 65 75 65 29 0a 20 (num-in-queue).
1670: 20 20 20 20 20 20 28 73 65 74 21 20 72 65 73 20 (set! res
1680: 6e 75 6d 2d 69 6e 2d 71 75 65 75 65 29 29 0a 20 num-in-queue)).
1690: 20 20 20 20 6d 64 62 0a 20 20 20 20 20 22 53 45 mdb. "SE
16a0: 4c 45 43 54 20 63 6f 75 6e 74 28 69 64 29 20 46 LECT count(id) F
16b0: 52 4f 4d 20 73 65 72 76 65 72 73 20 57 48 45 52 ROM servers WHER
16c0: 45 20 72 75 6e 5f 69 64 3d 3f 3b 22 0a 20 20 20 E run_id=?;".
16d0: 20 20 72 75 6e 2d 69 64 29 0a 20 20 20 20 72 65 run-id). re
16e0: 73 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 61 s))..(define (ta
16f0: 73 6b 73 3a 73 65 72 76 65 72 2d 63 6c 65 61 6e sks:server-clean
1700: 2d 6f 75 74 2d 6f 6c 64 2d 72 65 63 6f 72 64 73 -out-old-records
1710: 2d 66 6f 72 2d 72 75 6e 2d 69 64 20 6d 64 62 20 -for-run-id mdb
1720: 72 75 6e 2d 69 64 29 0a 20 20 28 73 71 6c 69 74 run-id). (sqlit
1730: 65 33 3a 65 78 65 63 75 74 65 20 6d 64 62 20 22 e3:execute mdb "
1740: 44 45 4c 45 54 45 20 46 52 4f 4d 20 73 65 72 76 DELETE FROM serv
1750: 65 72 73 20 57 48 45 52 45 20 73 74 61 74 65 20 ers WHERE state
1760: 69 6e 20 28 27 61 76 61 69 6c 61 62 6c 65 27 2c in ('available',
1770: 27 73 68 75 74 74 69 6e 67 2d 64 6f 77 6e 27 29 'shutting-down')
1780: 20 41 4e 44 20 28 73 74 72 66 74 69 6d 65 28 27 AND (strftime('
1790: 25 73 27 2c 27 6e 6f 77 27 29 20 2d 20 73 74 61 %s','now') - sta
17a0: 72 74 5f 74 69 6d 65 29 20 3e 20 31 30 30 20 41 rt_time) > 100 A
17b0: 4e 44 20 72 75 6e 5f 69 64 3d 3f 3b 22 20 72 75 ND run_id=?;" ru
17c0: 6e 2d 69 64 29 29 0a 0a 28 64 65 66 69 6e 65 20 n-id))..(define
17d0: 28 74 61 73 6b 73 3a 73 65 72 76 65 72 2d 66 6f (tasks:server-fo
17e0: 72 63 65 2d 63 6c 65 61 6e 2d 72 75 6e 6e 69 6e rce-clean-runnin
17f0: 67 2d 72 65 63 6f 72 64 73 2d 66 6f 72 2d 72 75 g-records-for-ru
1800: 6e 2d 69 64 20 6d 64 62 20 72 75 6e 2d 69 64 29 n-id mdb run-id)
1810: 0a 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 . (sqlite3:exec
1820: 75 74 65 20 6d 64 62 20 22 44 45 4c 45 54 45 20 ute mdb "DELETE
1830: 46 52 4f 4d 20 73 65 72 76 65 72 73 20 57 48 45 FROM servers WHE
1840: 52 45 20 73 74 61 74 65 20 3d 20 27 72 75 6e 6e RE state = 'runn
1850: 69 6e 67 27 20 41 4e 44 20 72 75 6e 5f 69 64 3d ing' AND run_id=
1860: 3f 3b 22 20 72 75 6e 2d 69 64 29 29 0a 0a 28 64 ?;" run-id))..(d
1870: 65 66 69 6e 65 20 28 74 61 73 6b 73 3a 73 65 72 efine (tasks:ser
1880: 76 65 72 2d 66 6f 72 63 65 2d 63 6c 65 61 6e 2d ver-force-clean-
1890: 72 75 6e 2d 72 65 63 6f 72 64 20 6d 64 62 20 72 run-record mdb r
18a0: 75 6e 2d 69 64 20 69 66 61 63 65 20 70 6f 72 74 un-id iface port
18b0: 29 0a 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 ). (sqlite3:exe
18c0: 63 75 74 65 20 6d 64 62 20 22 44 45 4c 45 54 45 cute mdb "DELETE
18d0: 20 46 52 4f 4d 20 73 65 72 76 65 72 73 20 57 48 FROM servers WH
18e0: 45 52 45 20 73 74 61 74 65 20 3d 20 27 72 75 6e ERE state = 'run
18f0: 6e 69 6e 67 27 20 41 4e 44 20 72 75 6e 5f 69 64 ning' AND run_id
1900: 3d 3f 20 41 4e 44 20 69 6e 74 65 72 66 61 63 65 =? AND interface
1910: 3d 3f 20 41 4e 44 20 70 6f 72 74 3d 3f 3b 22 0a =? AND port=?;".
1920: 09 09 20 20 20 72 75 6e 2d 69 64 20 69 66 61 63 .. run-id ifac
1930: 65 20 70 6f 72 74 29 29 0a 0a 28 64 65 66 69 6e e port))..(defin
1940: 65 20 28 74 61 73 6b 73 3a 73 65 72 76 65 72 2d e (tasks:server-
1950: 73 65 74 2d 73 74 61 74 65 21 20 6d 64 62 20 73 set-state! mdb s
1960: 65 72 76 65 72 2d 69 64 20 73 74 61 74 65 29 0a erver-id state).
1970: 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 (sqlite3:execu
1980: 74 65 20 6d 64 62 20 22 55 50 44 41 54 45 20 73 te mdb "UPDATE s
1990: 65 72 76 65 72 73 20 53 45 54 20 73 74 61 74 65 ervers SET state
19a0: 3d 3f 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 20 =? WHERE id=?;"
19b0: 73 74 61 74 65 20 73 65 72 76 65 72 2d 69 64 29 state server-id)
19c0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 61 73 6b )..(define (task
19d0: 73 3a 73 65 72 76 65 72 2d 64 65 6c 65 74 65 2d s:server-delete-
19e0: 72 65 63 6f 72 64 21 20 6d 64 62 20 73 65 72 76 record! mdb serv
19f0: 65 72 2d 69 64 29 0a 20 20 28 73 71 6c 69 74 65 er-id). (sqlite
1a00: 33 3a 65 78 65 63 75 74 65 20 6d 64 62 20 22 44 3:execute mdb "D
1a10: 45 4c 45 54 45 20 46 52 4f 4d 20 73 65 72 76 65 ELETE FROM serve
1a20: 72 73 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 20 rs WHERE id=?;"
1a30: 73 65 72 76 65 72 2d 69 64 29 29 0a 0a 28 64 65 server-id))..(de
1a40: 66 69 6e 65 20 28 74 61 73 6b 73 3a 73 65 72 76 fine (tasks:serv
1a50: 65 72 2d 64 65 6c 65 74 65 2d 72 65 63 6f 72 64 er-delete-record
1a60: 73 2d 66 6f 72 2d 74 68 69 73 2d 70 69 64 20 6d s-for-this-pid m
1a70: 64 62 29 0a 20 20 28 73 71 6c 69 74 65 33 3a 65 db). (sqlite3:e
1a80: 78 65 63 75 74 65 20 6d 64 62 20 22 44 45 4c 45 xecute mdb "DELE
1a90: 54 45 20 46 52 4f 4d 20 73 65 72 76 65 72 73 20 TE FROM servers
1aa0: 57 48 45 52 45 20 68 6f 73 74 6e 61 6d 65 3d 3f WHERE hostname=?
1ab0: 20 41 4e 44 20 70 69 64 3d 3f 3b 22 20 28 67 65 AND pid=?;" (ge
1ac0: 74 2d 68 6f 73 74 2d 6e 61 6d 65 29 20 28 63 75 t-host-name) (cu
1ad0: 72 72 65 6e 74 2d 70 72 6f 63 65 73 73 2d 69 64 rrent-process-id
1ae0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 61 )))..(define (ta
1af0: 73 6b 73 3a 73 65 72 76 65 72 2d 73 65 74 2d 69 sks:server-set-i
1b00: 6e 74 65 72 66 61 63 65 2d 70 6f 72 74 20 6d 64 nterface-port md
1b10: 62 20 73 65 72 76 65 72 2d 69 64 20 69 6e 74 65 b server-id inte
1b20: 72 66 61 63 65 20 70 6f 72 74 29 0a 20 20 28 73 rface port). (s
1b30: 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 6d qlite3:execute m
1b40: 64 62 20 22 55 50 44 41 54 45 20 73 65 72 76 65 db "UPDATE serve
1b50: 72 73 20 53 45 54 20 69 6e 74 65 72 66 61 63 65 rs SET interface
1b60: 3d 3f 2c 70 6f 72 74 3d 3f 20 57 48 45 52 45 20 =?,port=? WHERE
1b70: 69 64 3d 3f 3b 22 20 69 6e 74 65 72 66 61 63 65 id=?;" interface
1b80: 20 70 6f 72 74 20 73 65 72 76 65 72 2d 69 64 29 port server-id)
1b90: 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 61 73 6b )..(define (task
1ba0: 73 3a 73 65 72 76 65 72 2d 67 65 74 2d 6e 65 78 s:server-get-nex
1bb0: 74 2d 70 6f 72 74 20 6d 64 62 29 0a 20 20 28 6c t-port mdb). (l
1bc0: 65 74 20 28 28 72 65 73 20 20 20 20 20 20 20 20 et ((res
1bd0: 20 23 66 29 0a 09 28 70 6f 72 74 2d 70 61 72 61 #f)..(port-para
1be0: 6d 20 20 28 69 66 20 28 61 6e 64 20 28 61 72 67 m (if (and (arg
1bf0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 70 6f 72 74 s:get-arg "-port
1c00: 22 29 0a 09 09 09 20 20 20 20 20 20 28 73 74 72 ").... (str
1c10: 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 61 72 67 ing->number (arg
1c20: 73 3a 67 65 74 2d 61 72 67 20 22 2d 70 6f 72 74 s:get-arg "-port
1c30: 22 29 29 29 0a 09 09 09 20 28 73 74 72 69 6e 67 "))).... (string
1c40: 2d 3e 6e 75 6d 62 65 72 20 28 61 72 67 73 3a 67 ->number (args:g
1c50: 65 74 2d 61 72 67 20 22 2d 70 6f 72 74 22 29 29 et-arg "-port"))
1c60: 0a 09 09 09 20 23 66 29 29 0a 09 28 63 6f 6e 66 .... #f))..(conf
1c70: 69 67 2d 70 6f 72 74 20 28 69 66 20 28 61 6e 64 ig-port (if (and
1c80: 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 (config-lookup
1c90: 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 *configdat* "se
1ca0: 72 76 65 72 22 20 22 70 6f 72 74 22 29 0a 09 09 rver" "port")...
1cb0: 09 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 3e . (string->
1cc0: 6e 75 6d 62 65 72 20 28 63 6f 6e 66 69 67 2d 6c number (config-l
1cd0: 6f 6f 6b 75 70 20 20 2a 63 6f 6e 66 69 67 64 61 ookup *configda
1ce0: 74 2a 20 22 73 65 72 76 65 72 22 20 22 70 6f 72 t* "server" "por
1cf0: 74 22 29 29 29 0a 09 09 09 20 28 73 74 72 69 6e t"))).... (strin
1d00: 67 2d 3e 6e 75 6d 62 65 72 20 28 63 6f 6e 66 69 g->number (confi
1d10: 67 2d 6c 6f 6f 6b 75 70 20 20 2a 63 6f 6e 66 69 g-lookup *confi
1d20: 67 64 61 74 2a 20 22 73 65 72 76 65 72 22 20 22 gdat* "server" "
1d30: 70 6f 72 74 22 29 29 0a 09 09 09 20 23 66 29 29 port")).... #f))
1d40: 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 ). (sqlite3:f
1d50: 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 20 20 20 20 or-each-row.
1d60: 20 28 6c 61 6d 62 64 61 20 28 70 6f 72 74 29 0a (lambda (port).
1d70: 20 20 20 20 20 20 20 28 73 65 74 21 20 72 65 73 (set! res
1d80: 20 28 2b 20 70 6f 72 74 20 31 29 29 29 20 3b 3b (+ port 1))) ;;
1d90: 20 73 65 74 20 74 6f 20 6e 65 78 74 0a 20 20 20 set to next.
1da0: 20 20 6d 64 62 0a 20 20 20 20 20 22 53 45 4c 45 mdb. "SELE
1db0: 43 54 20 6d 61 78 28 70 6f 72 74 29 20 46 52 4f CT max(port) FRO
1dc0: 4d 20 73 65 72 76 65 72 73 3b 22 29 0a 20 20 20 M servers;").
1dd0: 20 28 63 6f 6e 64 0a 20 20 20 20 20 28 28 61 6e (cond. ((an
1de0: 64 20 70 6f 72 74 2d 70 61 72 61 6d 20 72 65 73 d port-param res
1df0: 29 20 20 20 28 69 66 20 28 3e 20 72 65 73 20 70 ) (if (> res p
1e00: 6f 72 74 2d 70 61 72 61 6d 29 20 72 65 73 20 70 ort-param) res p
1e10: 6f 72 74 2d 70 61 72 61 6d 29 29 0a 20 20 20 20 ort-param)).
1e20: 20 28 70 6f 72 74 2d 70 61 72 61 6d 20 20 20 20 (port-param
1e30: 20 20 20 20 20 20 20 20 20 70 6f 72 74 2d 70 61 port-pa
1e40: 72 61 6d 29 0a 20 20 20 20 20 28 28 61 6e 64 20 ram). ((and
1e50: 63 6f 6e 66 69 67 2d 70 6f 72 74 20 72 65 73 29 config-port res)
1e60: 20 20 28 69 66 20 28 3e 20 72 65 73 20 63 6f 6e (if (> res con
1e70: 66 69 67 2d 70 6f 72 74 29 20 72 65 73 20 63 6f fig-port) res co
1e80: 6e 66 69 67 2d 70 6f 72 74 29 29 0a 20 20 20 20 nfig-port)).
1e90: 20 28 63 6f 6e 66 69 67 2d 70 6f 72 74 20 20 20 (config-port
1ea0: 20 20 20 20 20 20 20 20 20 63 6f 6e 66 69 67 2d config-
1eb0: 70 6f 72 74 29 0a 20 20 20 20 20 28 28 61 6e 64 port). ((and
1ec0: 20 72 65 73 20 28 3e 20 72 65 73 20 38 30 38 30 res (> res 8080
1ed0: 29 29 20 72 65 73 29 0a 20 20 20 20 20 28 65 6c )) res). (el
1ee0: 73 65 20 20 20 20 20 20 20 20 20 20 20 20 20 20 se
1ef0: 20 20 20 20 20 28 2b 20 35 30 30 30 20 28 72 61 (+ 5000 (ra
1f00: 6e 64 6f 6d 20 31 30 30 31 29 29 29 29 29 29 0a ndom 1001)))))).
1f10: 0a 28 64 65 66 69 6e 65 20 28 74 61 73 6b 73 3a .(define (tasks:
1f20: 73 65 72 76 65 72 2d 61 6d 2d 69 2d 74 68 65 2d server-am-i-the-
1f30: 73 65 72 76 65 72 3f 20 6d 64 62 20 72 75 6e 2d server? mdb run-
1f40: 69 64 29 0a 20 20 28 6c 65 74 2a 20 28 28 61 6c id). (let* ((al
1f50: 6c 20 20 20 20 28 74 61 73 6b 73 3a 73 65 72 76 l (tasks:serv
1f60: 65 72 2d 67 65 74 2d 73 65 72 76 65 72 73 2d 76 er-get-servers-v
1f70: 79 69 6e 67 2d 66 6f 72 2d 72 75 6e 2d 69 64 20 ying-for-run-id
1f80: 6d 64 62 20 72 75 6e 2d 69 64 29 29 0a 09 20 28 mdb run-id)).. (
1f90: 66 69 72 73 74 20 20 28 69 66 20 28 6e 75 6c 6c first (if (null
1fa0: 3f 20 61 6c 6c 29 0a 09 09 20 20 20 20 20 28 62 ? all)... (b
1fb0: 65 67 69 6e 20 28 64 65 62 75 67 3a 70 72 69 6e egin (debug:prin
1fc0: 74 20 30 20 22 45 52 52 4f 52 3a 20 6e 6f 20 73 t 0 "ERROR: no s
1fd0: 65 72 76 65 72 73 20 6c 69 73 74 65 64 2c 20 73 ervers listed, s
1fe0: 68 6f 75 6c 64 20 62 65 20 61 74 20 6c 65 61 73 hould be at leas
1ff0: 74 20 6f 6e 65 20 62 79 20 6e 6f 77 2e 22 29 20 t one by now.")
2000: 0a 09 09 09 20 20 20 20 28 73 71 6c 69 74 65 33 .... (sqlite3
2010: 3a 66 69 6e 61 6c 69 7a 65 21 20 6d 64 62 29 0a :finalize! mdb).
2020: 09 09 09 20 20 20 20 28 65 78 69 74 20 31 29 29 ... (exit 1))
2030: 0a 09 09 20 20 20 20 20 28 63 61 72 20 28 64 62 ... (car (db
2040: 3a 67 65 74 2d 72 6f 77 73 20 61 6c 6c 29 29 29 :get-rows all)))
2050: 29 0a 09 20 28 68 65 61 64 65 72 20 20 20 28 64 ).. (header (d
2060: 62 3a 67 65 74 2d 68 65 61 64 65 72 20 61 6c 6c b:get-header all
2070: 29 29 0a 09 20 28 69 64 20 20 20 20 20 20 20 28 )).. (id (
2080: 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d db:get-value-by-
2090: 68 65 61 64 65 72 20 66 69 72 73 74 20 68 65 61 header first hea
20a0: 64 65 72 20 22 69 64 22 29 29 0a 09 20 28 68 6f der "id")).. (ho
20b0: 73 74 6e 61 6d 65 20 28 64 62 3a 67 65 74 2d 76 stname (db:get-v
20c0: 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 66 alue-by-header f
20d0: 69 72 73 74 20 68 65 61 64 65 72 20 22 68 6f 73 irst header "hos
20e0: 74 6e 61 6d 65 22 29 29 0a 09 20 28 70 69 64 20 tname")).. (pid
20f0: 20 20 20 20 20 28 64 62 3a 67 65 74 2d 76 61 6c (db:get-val
2100: 75 65 2d 62 79 2d 68 65 61 64 65 72 20 66 69 72 ue-by-header fir
2110: 73 74 20 68 65 61 64 65 72 20 22 70 69 64 22 29 st header "pid")
2120: 29 0a 09 20 28 70 72 69 6f 72 69 74 79 20 28 64 ).. (priority (d
2130: 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 b:get-value-by-h
2140: 65 61 64 65 72 20 66 69 72 73 74 20 68 65 61 64 eader first head
2150: 65 72 20 22 70 72 69 6f 72 69 74 79 22 29 29 29 er "priority")))
2160: 0a 20 20 20 20 3b 3b 20 66 6f 72 20 6e 6f 77 20 . ;; for now
2170: 61 20 62 61 73 69 63 20 63 68 65 63 6b 2e 20 61 a basic check. a
2180: 64 64 20 74 69 65 62 72 65 61 6b 69 6e 67 20 62 dd tiebreaking b
2190: 79 20 70 72 69 6f 72 69 74 79 20 6c 61 74 65 72 y priority later
21a0: 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 6d 79 2d . (let* ((my-
21b0: 70 69 64 20 28 63 75 72 72 65 6e 74 2d 70 72 6f pid (current-pro
21c0: 63 65 73 73 2d 69 64 29 29 0a 09 20 20 20 28 72 cess-id)).. (r
21d0: 65 73 20 28 69 66 20 28 61 6e 64 20 28 65 71 75 es (if (and (equ
21e0: 61 6c 3f 20 68 6f 73 74 6e 61 6d 65 20 28 67 65 al? hostname (ge
21f0: 74 2d 68 6f 73 74 2d 6e 61 6d 65 29 29 0a 09 09 t-host-name))...
2200: 09 20 28 65 71 75 61 6c 3f 20 70 69 64 20 20 20 . (equal? pid
2210: 20 20 20 20 6d 79 2d 70 69 64 29 29 0a 09 09 20 my-pid))...
2220: 20 20 20 69 64 0a 09 09 20 20 20 20 23 66 29 29 id... #f))
2230: 29 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 ). (debug:p
2240: 72 69 6e 74 20 30 20 22 49 4e 46 4f 3a 20 61 6d rint 0 "INFO: am
2250: 2d 69 2d 74 68 65 2d 73 65 72 76 65 72 20 67 6f -i-the-server go
2260: 74 20 72 65 63 6f 72 64 20 22 20 66 69 72 73 74 t record " first
2270: 20 22 2c 20 6d 79 2d 70 69 64 3a 20 22 20 6d 79 ", my-pid: " my
2280: 2d 70 69 64 20 22 2c 20 70 69 64 3a 20 22 20 70 -pid ", pid: " p
2290: 69 64 20 22 2c 20 72 65 73 75 6c 74 3a 20 22 20 id ", result: "
22a0: 72 65 73 29 0a 20 20 20 20 20 20 72 65 73 29 29 res). res))
22b0: 29 0a 20 20 20 20 20 20 0a 09 20 20 20 20 20 0a ). .. .
22c0: 3b 3b 20 55 73 65 3a 20 28 64 62 3a 67 65 74 2d ;; Use: (db:get-
22d0: 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 value-by-header
22e0: 28 63 61 72 20 28 64 62 3a 67 65 74 2d 72 6f 77 (car (db:get-row
22f0: 73 20 64 61 74 29 29 20 28 64 62 3a 67 65 74 2d s dat)) (db:get-
2300: 68 65 61 64 65 72 20 64 61 74 29 20 22 66 69 65 header dat) "fie
2310: 6c 64 6e 61 6d 65 22 29 0a 3b 3b 20 20 74 6f 20 ldname").;; to
2320: 65 78 74 72 61 63 74 20 69 6e 66 6f 20 66 72 6f extract info fro
2330: 6d 20 74 68 65 20 73 74 72 75 63 74 75 72 65 20 m the structure
2340: 72 65 74 75 72 6e 65 64 0a 3b 3b 0a 28 64 65 66 returned.;;.(def
2350: 69 6e 65 20 28 74 61 73 6b 73 3a 73 65 72 76 65 ine (tasks:serve
2360: 72 2d 67 65 74 2d 73 65 72 76 65 72 73 2d 76 79 r-get-servers-vy
2370: 69 6e 67 2d 66 6f 72 2d 72 75 6e 2d 69 64 20 6d ing-for-run-id m
2380: 64 62 20 72 75 6e 2d 69 64 29 0a 20 20 20 28 6c db run-id). (l
2390: 65 74 2a 20 28 28 68 65 61 64 65 72 20 28 6c 69 et* ((header (li
23a0: 73 74 20 22 69 64 22 20 22 68 6f 73 74 6e 61 6d st "id" "hostnam
23b0: 65 22 20 22 70 69 64 22 20 22 69 6e 74 65 72 66 e" "pid" "interf
23c0: 61 63 65 22 20 22 70 6f 72 74 22 20 22 70 75 62 ace" "port" "pub
23d0: 70 6f 72 74 22 20 22 73 74 61 74 65 22 20 22 72 port" "state" "r
23e0: 75 6e 5f 69 64 22 20 22 70 72 69 6f 72 69 74 79 un_id" "priority
23f0: 22 20 22 73 74 61 72 74 5f 74 69 6d 65 22 29 29 " "start_time"))
2400: 0a 09 20 20 28 73 65 6c 73 74 72 20 28 73 74 72 .. (selstr (str
2410: 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 ing-intersperse
2420: 68 65 61 64 65 72 20 22 2c 22 29 29 0a 09 20 20 header ","))..
2430: 28 72 65 73 20 20 20 20 27 28 29 29 29 0a 20 20 (res '())).
2440: 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 (sqlite3:for-e
2450: 61 63 68 2d 72 6f 77 0a 20 20 20 20 20 28 6c 61 ach-row. (la
2460: 6d 62 64 61 20 28 61 20 2e 20 62 29 0a 20 20 20 mbda (a . b).
2470: 20 20 20 20 28 73 65 74 21 20 72 65 73 20 28 63 (set! res (c
2480: 6f 6e 73 20 28 61 70 70 6c 79 20 76 65 63 74 6f ons (apply vecto
2490: 72 20 61 20 62 29 20 72 65 73 29 29 29 0a 20 20 r a b) res))).
24a0: 20 20 20 6d 64 62 0a 20 20 20 20 20 28 63 6f 6e mdb. (con
24b0: 63 20 22 53 45 4c 45 43 54 20 22 20 73 65 6c 73 c "SELECT " sels
24c0: 74 72 20 22 20 46 52 4f 4d 20 73 65 72 76 65 72 tr " FROM server
24d0: 73 20 57 48 45 52 45 20 72 75 6e 5f 69 64 3d 3f s WHERE run_id=?
24e0: 20 4f 52 44 45 52 20 42 59 20 73 74 61 72 74 5f ORDER BY start_
24f0: 74 69 6d 65 20 44 45 53 43 3b 22 29 0a 20 20 20 time DESC;").
2500: 20 20 72 75 6e 2d 69 64 29 0a 20 20 20 20 28 76 run-id). (v
2510: 65 63 74 6f 72 20 68 65 61 64 65 72 20 72 65 73 ector header res
2520: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 61 )))..(define (ta
2530: 73 6b 73 3a 67 65 74 2d 73 65 72 76 65 72 20 6d sks:get-server m
2540: 64 62 20 72 75 6e 2d 69 64 29 0a 20 20 28 6c 65 db run-id). (le
2550: 74 20 28 28 72 65 73 20 20 23 66 29 0a 09 28 62 t ((res #f)..(b
2560: 65 73 74 20 23 66 29 29 0a 20 20 20 20 28 73 71 est #f)). (sq
2570: 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 lite3:for-each-r
2580: 6f 77 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 ow. (lambda
2590: 28 69 64 20 69 6e 74 65 72 66 61 63 65 20 70 6f (id interface po
25a0: 72 74 20 70 75 62 70 6f 72 74 20 74 72 61 6e 73 rt pubport trans
25b0: 70 6f 72 74 20 70 69 64 20 68 6f 73 74 6e 61 6d port pid hostnam
25c0: 65 29 0a 20 20 20 20 20 20 20 28 73 65 74 21 20 e). (set!
25d0: 72 65 73 20 28 76 65 63 74 6f 72 20 69 64 20 69 res (vector id i
25e0: 6e 74 65 72 66 61 63 65 20 70 6f 72 74 20 70 75 nterface port pu
25f0: 62 70 6f 72 74 20 74 72 61 6e 73 70 6f 72 74 20 bport transport
2600: 70 69 64 20 68 6f 73 74 6e 61 6d 65 29 29 29 0a pid hostname))).
2610: 20 20 20 20 20 6d 64 62 0a 20 20 20 20 20 3b 3b mdb. ;;
2620: 20 72 65 6d 6f 76 65 64 3a 0a 20 20 20 20 20 3b removed:. ;
2630: 3b 20 73 74 72 66 74 69 6d 65 28 27 25 73 27 2c ; strftime('%s',
2640: 27 6e 6f 77 27 29 2d 68 65 61 72 74 62 65 61 74 'now')-heartbeat
2650: 20 3c 20 31 30 20 41 4e 44 20 6d 74 5f 76 65 72 < 10 AND mt_ver
2660: 73 69 6f 6e 20 3d 20 3f 0a 20 20 20 20 20 22 53 sion = ?. "S
2670: 45 4c 45 43 54 20 69 64 2c 69 6e 74 65 72 66 61 ELECT id,interfa
2680: 63 65 2c 70 6f 72 74 2c 70 75 62 70 6f 72 74 2c ce,port,pubport,
2690: 74 72 61 6e 73 70 6f 72 74 2c 70 69 64 2c 68 6f transport,pid,ho
26a0: 73 74 6e 61 6d 65 20 46 52 4f 4d 20 73 65 72 76 stname FROM serv
26b0: 65 72 73 0a 20 20 20 20 20 20 20 20 20 20 57 48 ers. WH
26c0: 45 52 45 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 ERE run_id=? AND
26d0: 20 73 74 61 74 65 3d 27 72 75 6e 6e 69 6e 67 27 state='running'
26e0: 0a 20 20 20 20 20 20 20 20 20 20 4f 52 44 45 52 . ORDER
26f0: 20 42 59 20 73 74 61 72 74 5f 74 69 6d 65 20 44 BY start_time D
2700: 45 53 43 20 4c 49 4d 49 54 20 31 3b 22 20 72 75 ESC LIMIT 1;" ru
2710: 6e 2d 69 64 29 20 3b 3b 20 28 63 6f 6d 6d 6f 6e n-id) ;; (common
2720: 3a 76 65 72 73 69 6f 6e 2d 73 69 67 6e 61 74 75 :version-signatu
2730: 72 65 29 20 72 75 6e 2d 69 64 29 0a 20 20 20 20 re) run-id).
2740: 72 65 73 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 res))..(define (
2750: 74 61 73 6b 73 3a 67 65 74 2d 61 6c 6c 2d 73 65 tasks:get-all-se
2760: 72 76 65 72 73 20 6d 64 62 29 0a 20 20 28 6c 65 rvers mdb). (le
2770: 74 20 28 28 72 65 73 20 27 28 29 29 29 0a 20 20 t ((res '())).
2780: 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 (sqlite3:for-e
2790: 61 63 68 2d 72 6f 77 0a 20 20 20 20 20 28 6c 61 ach-row. (la
27a0: 6d 62 64 61 20 28 69 64 20 70 69 64 20 68 6f 73 mbda (id pid hos
27b0: 74 6e 61 6d 65 20 69 6e 74 65 72 66 61 63 65 20 tname interface
27c0: 70 6f 72 74 20 70 75 62 70 6f 72 74 20 73 74 61 port pubport sta
27d0: 72 74 2d 74 69 6d 65 20 70 72 69 6f 72 69 74 79 rt-time priority
27e0: 20 73 74 61 74 65 20 6d 74 2d 76 65 72 73 69 6f state mt-versio
27f0: 6e 20 6c 61 73 74 2d 75 70 64 61 74 65 20 74 72 n last-update tr
2800: 61 6e 73 70 6f 72 74 29 0a 20 20 20 20 20 20 20 ansport).
2810: 28 73 65 74 21 20 72 65 73 20 28 63 6f 6e 73 20 (set! res (cons
2820: 28 76 65 63 74 6f 72 20 69 64 20 70 69 64 20 68 (vector id pid h
2830: 6f 73 74 6e 61 6d 65 20 69 6e 74 65 72 66 61 63 ostname interfac
2840: 65 20 70 6f 72 74 20 70 75 62 70 6f 72 74 20 73 e port pubport s
2850: 74 61 72 74 2d 74 69 6d 65 20 70 72 69 6f 72 69 tart-time priori
2860: 74 79 20 73 74 61 74 65 20 6d 74 2d 76 65 72 73 ty state mt-vers
2870: 69 6f 6e 20 6c 61 73 74 2d 75 70 64 61 74 65 20 ion last-update
2880: 74 72 61 6e 73 70 6f 72 74 29 20 72 65 73 29 29 transport) res))
2890: 29 0a 20 20 20 20 20 6d 64 62 0a 20 20 20 20 20 ). mdb.
28a0: 22 53 45 4c 45 43 54 20 69 64 2c 70 69 64 2c 68 "SELECT id,pid,h
28b0: 6f 73 74 6e 61 6d 65 2c 69 6e 74 65 72 66 61 63 ostname,interfac
28c0: 65 2c 70 6f 72 74 2c 70 75 62 70 6f 72 74 2c 73 e,port,pubport,s
28d0: 74 61 72 74 5f 74 69 6d 65 2c 70 72 69 6f 72 69 tart_time,priori
28e0: 74 79 2c 73 74 61 74 65 2c 6d 74 5f 76 65 72 73 ty,state,mt_vers
28f0: 69 6f 6e 2c 73 74 72 66 74 69 6d 65 28 27 25 73 ion,strftime('%s
2900: 27 2c 27 6e 6f 77 27 29 2d 68 65 61 72 74 62 65 ','now')-heartbe
2910: 61 74 20 41 53 20 6c 61 73 74 5f 75 70 64 61 74 at AS last_updat
2920: 65 2c 74 72 61 6e 73 70 6f 72 74 20 46 52 4f 4d e,transport FROM
2930: 20 73 65 72 76 65 72 73 20 4f 52 44 45 52 20 42 servers ORDER B
2940: 59 20 73 74 61 72 74 5f 74 69 6d 65 20 44 45 53 Y start_time DES
2950: 43 3b 22 29 0a 20 20 20 20 72 65 73 29 29 0a 0a C;"). res))..
2960: 28 64 65 66 69 6e 65 20 28 74 61 73 6b 73 3a 6b (define (tasks:k
2970: 69 6c 6c 2d 73 65 72 76 65 72 20 73 74 61 74 75 ill-server statu
2980: 73 20 68 6f 73 74 6e 61 6d 65 20 70 6f 72 74 20 s hostname port
2990: 70 69 64 29 0a 20 20 28 64 65 62 75 67 3a 70 72 pid). (debug:pr
29a0: 69 6e 74 2d 69 6e 66 6f 20 31 20 22 52 65 6d 6f int-info 1 "Remo
29b0: 76 69 6e 67 20 64 65 66 75 6e 63 74 20 73 65 72 ving defunct ser
29c0: 76 65 72 20 72 65 63 6f 72 64 20 66 6f 72 20 22 ver record for "
29d0: 20 68 6f 73 74 6e 61 6d 65 20 22 3a 22 20 70 6f hostname ":" po
29e0: 72 74 29 0a 20 20 28 69 66 20 70 6f 72 74 0a 20 rt). (if port.
29f0: 20 20 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 (open-run-c
2a00: 6c 6f 73 65 20 74 61 73 6b 73 3a 73 65 72 76 65 lose tasks:serve
2a10: 72 2d 64 65 72 65 67 69 73 74 65 72 20 74 61 73 r-deregister tas
2a20: 6b 73 3a 6f 70 65 6e 2d 64 62 20 68 6f 73 74 6e ks:open-db hostn
2a30: 61 6d 65 20 70 6f 72 74 3a 20 70 6f 72 74 29 0a ame port: port).
2a40: 20 20 20 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d (open-run-
2a50: 63 6c 6f 73 65 20 74 61 73 6b 73 3a 73 65 72 76 close tasks:serv
2a60: 65 72 2d 64 65 72 65 67 69 73 74 65 72 20 74 61 er-deregister ta
2a70: 73 6b 73 3a 6f 70 65 6e 2d 64 62 20 68 6f 73 74 sks:open-db host
2a80: 6e 61 6d 65 20 70 69 64 3a 20 20 70 69 64 29 29 name pid: pid))
2a90: 0a 20 20 28 69 66 20 73 74 61 74 75 73 20 3b 3b . (if status ;;
2aa0: 20 23 74 20 6d 65 61 6e 73 20 61 6c 69 76 65 0a #t means alive.
2ab0: 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 28 69 (begin..(i
2ac0: 66 20 28 65 71 75 61 6c 3f 20 68 6f 73 74 6e 61 f (equal? hostna
2ad0: 6d 65 20 28 67 65 74 2d 68 6f 73 74 2d 6e 61 6d me (get-host-nam
2ae0: 65 29 29 0a 09 20 20 20 20 28 68 61 6e 64 6c 65 e)).. (handle
2af0: 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 20 20 20 -exceptions..
2b00: 20 20 65 78 6e 0a 09 20 20 20 20 20 28 64 65 62 exn.. (deb
2b10: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 ug:print-info 0
2b20: 22 73 65 72 76 65 72 20 6d 61 79 20 6f 72 20 6d "server may or m
2b30: 61 79 20 6e 6f 74 20 62 65 20 64 65 61 64 2c 20 ay not be dead,
2b40: 63 68 65 63 6b 20 66 6f 72 20 6d 65 67 61 74 65 check for megate
2b50: 73 74 20 2d 73 65 72 76 65 72 20 72 75 6e 6e 69 st -server runni
2b60: 6e 67 20 61 73 20 70 69 64 20 22 20 70 69 64 20 ng as pid " pid
2b70: 22 5c 6e 22 0a 09 09 09 20 20 20 20 20 20 20 22 "\n".... "
2b80: 20 20 45 58 43 45 50 54 49 4f 4e 3a 20 22 20 28 EXCEPTION: " (
2b90: 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 65 (condition-prope
2ba0: 72 74 79 2d 61 63 63 65 73 73 6f 72 20 27 65 78 rty-accessor 'ex
2bb0: 6e 20 27 6d 65 73 73 61 67 65 29 20 65 78 6e 29 n 'message) exn)
2bc0: 29 0a 09 20 20 20 20 20 28 64 65 62 75 67 3a 70 ).. (debug:p
2bd0: 72 69 6e 74 20 31 20 22 53 65 6e 64 69 6e 67 20 rint 1 "Sending
2be0: 73 69 67 6e 61 6c 2f 74 65 72 6d 20 74 6f 20 22 signal/term to "
2bf0: 20 70 69 64 20 22 20 6f 6e 20 22 20 68 6f 73 74 pid " on " host
2c00: 6e 61 6d 65 29 0a 09 20 20 20 20 20 28 70 72 6f name).. (pro
2c10: 63 65 73 73 2d 73 69 67 6e 61 6c 20 70 69 64 20 cess-signal pid
2c20: 73 69 67 6e 61 6c 2f 74 65 72 6d 29 0a 09 20 20 signal/term)..
2c30: 20 20 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 (thread-sleep
2c40: 21 20 35 29 20 3b 3b 20 67 69 76 65 20 69 74 20 ! 5) ;; give it
2c50: 66 69 76 65 20 73 65 63 6f 6e 64 73 20 74 6f 20 five seconds to
2c60: 64 69 65 20 70 65 61 63 65 66 75 6c 6c 79 20 74 die peacefully t
2c70: 68 65 6e 20 64 6f 20 61 20 62 72 75 74 61 6c 20 hen do a brutal
2c80: 6b 69 6c 6c 0a 09 20 20 20 20 20 3b 3b 28 70 72 kill.. ;;(pr
2c90: 6f 63 65 73 73 2d 73 69 67 6e 61 6c 20 70 69 64 ocess-signal pid
2ca0: 20 73 69 67 6e 61 6c 2f 6b 69 6c 6c 29 0a 09 20 signal/kill)..
2cb0: 20 20 20 20 29 20 3b 3b 20 6c 6f 63 61 6c 20 6d ) ;; local m
2cc0: 61 63 68 69 6e 65 2c 20 73 65 6e 64 20 73 69 67 achine, send sig
2cd0: 20 74 65 72 6d 0a 09 20 20 20 20 28 62 65 67 69 term.. (begi
2ce0: 6e 0a 09 20 20 20 20 20 20 3b 3b 28 64 65 62 75 n.. ;;(debu
2cf0: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 20 22 g:print-info 1 "
2d00: 53 74 6f 70 70 69 6e 67 20 72 65 6d 6f 74 65 20 Stopping remote
2d10: 73 65 72 76 65 72 73 20 6e 6f 74 20 79 65 74 20 servers not yet
2d20: 73 75 70 70 6f 72 74 65 64 2e 22 29 29 29 29 0a supported.")))).
2d30: 09 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
2d40: 69 6e 74 2d 69 6e 66 6f 20 31 20 22 54 65 6c 6c int-info 1 "Tell
2d50: 69 6e 67 20 61 6c 69 76 65 20 73 65 72 76 65 72 ing alive server
2d60: 20 6f 6e 20 22 20 68 6f 73 74 6e 61 6d 65 20 22 on " hostname "
2d70: 3a 22 20 70 6f 72 74 20 22 20 74 6f 20 63 6f 6d :" port " to com
2d80: 6d 69 74 20 73 65 72 76 65 72 63 69 64 65 22 29 mit servercide")
2d90: 0a 09 20 20 20 20 20 20 28 6c 65 74 20 28 28 73 .. (let ((s
2da0: 65 72 76 65 72 64 61 74 20 28 6c 69 73 74 20 68 erverdat (list h
2db0: 6f 73 74 6e 61 6d 65 20 70 6f 72 74 29 29 29 0a ostname port))).
2dc0: 09 09 28 68 74 74 70 2d 74 72 61 6e 73 70 6f 72 ..(http-transpor
2dd0: 74 3a 63 6c 69 65 6e 74 2d 63 6f 6e 6e 65 63 74 t:client-connect
2de0: 20 68 6f 73 74 6e 61 6d 65 20 70 6f 72 74 29 0a hostname port).
2df0: 09 20 20 20 20 20 20 09 28 63 64 62 3a 6b 69 6c . .(cdb:kil
2e00: 6c 2d 73 65 72 76 65 72 20 73 65 72 76 65 72 64 l-server serverd
2e10: 61 74 20 70 69 64 29 29 29 29 29 20 20 20 20 3b at pid))))) ;
2e20: 3b 20 72 65 6d 6f 74 65 20 6d 61 63 68 69 6e 65 ; remote machine
2e30: 2c 20 74 72 79 20 74 65 6c 6c 69 6e 67 20 73 65 , try telling se
2e40: 72 76 65 72 20 74 6f 20 63 6f 6d 6d 69 74 20 73 rver to commit s
2e50: 75 69 63 69 64 65 0a 20 20 20 20 20 20 28 62 65 uicide. (be
2e60: 67 69 6e 0a 09 28 69 66 20 73 74 61 74 75 73 20 gin..(if status
2e70: 0a 09 20 20 20 20 28 69 66 20 28 65 71 75 61 6c .. (if (equal
2e80: 3f 20 68 6f 73 74 6e 61 6d 65 20 28 67 65 74 2d ? hostname (get-
2e90: 68 6f 73 74 2d 6e 61 6d 65 29 29 0a 09 09 28 62 host-name))...(b
2ea0: 65 67 69 6e 0a 09 09 20 20 28 64 65 62 75 67 3a egin... (debug:
2eb0: 70 72 69 6e 74 2d 69 6e 66 6f 20 31 20 22 53 65 print-info 1 "Se
2ec0: 6e 64 69 6e 67 20 73 69 67 6e 61 6c 2f 74 65 72 nding signal/ter
2ed0: 6d 20 74 6f 20 22 20 70 69 64 20 22 20 6f 6e 20 m to " pid " on
2ee0: 22 20 68 6f 73 74 6e 61 6d 65 29 0a 09 09 20 20 " hostname)...
2ef0: 28 70 72 6f 63 65 73 73 2d 73 69 67 6e 61 6c 20 (process-signal
2f00: 70 69 64 20 73 69 67 6e 61 6c 2f 74 65 72 6d 29 pid signal/term)
2f10: 20 20 3b 3b 20 6c 6f 63 61 6c 20 6d 61 63 68 69 ;; local machi
2f20: 6e 65 2c 20 73 65 6e 64 20 73 69 67 20 74 65 72 ne, send sig ter
2f30: 6d 0a 09 09 20 20 28 74 68 72 65 61 64 2d 73 6c m... (thread-sl
2f40: 65 65 70 21 20 35 29 20 20 20 20 20 20 20 20 20 eep! 5)
2f50: 20 20 20 20 20 20 20 20 3b 3b 20 67 69 76 65 20 ;; give
2f60: 69 74 20 66 69 76 65 20 73 65 63 6f 6e 64 73 20 it five seconds
2f70: 74 6f 20 64 69 65 20 70 65 61 63 65 66 75 6c 6c to die peacefull
2f80: 79 20 74 68 65 6e 20 64 6f 20 61 20 62 72 75 74 y then do a brut
2f90: 61 6c 20 6b 69 6c 6c 0a 09 09 20 20 28 70 72 6f al kill... (pro
2fa0: 63 65 73 73 2d 73 69 67 6e 61 6c 20 70 69 64 20 cess-signal pid
2fb0: 73 69 67 6e 61 6c 2f 6b 69 6c 6c 29 29 20 0a 09 signal/kill)) ..
2fc0: 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 .(debug:print 0
2fd0: 22 57 41 52 4e 49 4e 47 3a 20 43 61 6e 27 74 20 "WARNING: Can't
2fe0: 6b 69 6c 6c 20 66 72 6f 7a 65 6e 20 73 65 72 76 kill frozen serv
2ff0: 65 72 20 6f 6e 20 72 65 6d 6f 74 65 20 68 6f 73 er on remote hos
3000: 74 20 22 20 68 6f 73 74 6e 61 6d 65 29 29 29 29 t " hostname))))
3010: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
3020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3040: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3050: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
3060: 54 61 73 6b 73 20 61 6e 64 20 54 61 73 6b 20 6d Tasks and Task m
3070: 6f 6e 69 74 6f 72 73 0a 3b 3b 3d 3d 3d 3d 3d 3d onitors.;;======
3080: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3090: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
30a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
30b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
30c0: 0a 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ...;;===========
30d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
30e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
30f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3100: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 54 ===========.;; T
3110: 61 73 6b 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d asks.;;=========
3120: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3130: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3140: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3150: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 0a =============...
3160: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
3170: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3180: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3190: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
31a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 54 61 73 =========.;; Tas
31b0: 6b 20 4d 6f 6e 69 74 6f 72 73 0a 3b 3b 3d 3d 3d k Monitors.;;===
31c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
31d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
31e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
31f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3200: 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 74 61 ===..(define (ta
3210: 73 6b 73 3a 72 65 67 69 73 74 65 72 2d 6d 6f 6e sks:register-mon
3220: 69 74 6f 72 20 64 62 20 6d 64 62 29 0a 20 20 28 itor db mdb). (
3230: 6c 65 74 2a 20 28 28 70 69 64 20 28 63 75 72 72 let* ((pid (curr
3240: 65 6e 74 2d 70 72 6f 63 65 73 73 2d 69 64 29 29 ent-process-id))
3250: 0a 09 20 28 68 6f 73 74 6e 61 6d 65 20 28 67 65 .. (hostname (ge
3260: 74 2d 68 6f 73 74 2d 6e 61 6d 65 29 29 0a 09 20 t-host-name))..
3270: 28 75 73 65 72 69 6e 66 6f 20 28 75 73 65 72 2d (userinfo (user-
3280: 69 6e 66 6f 72 6d 61 74 69 6f 6e 20 28 63 75 72 information (cur
3290: 72 65 6e 74 2d 75 73 65 72 2d 69 64 29 29 29 0a rent-user-id))).
32a0: 09 20 28 75 73 65 72 6e 61 6d 65 20 28 63 61 72 . (username (car
32b0: 20 75 73 65 72 69 6e 66 6f 29 29 29 0a 20 20 20 userinfo))).
32c0: 20 28 70 72 69 6e 74 20 22 52 65 67 69 73 74 65 (print "Registe
32d0: 72 20 6d 6f 6e 69 74 6f 72 2c 20 70 69 64 3a 20 r monitor, pid:
32e0: 22 20 70 69 64 20 22 2c 20 68 6f 73 74 6e 61 6d " pid ", hostnam
32f0: 65 3a 20 22 20 68 6f 73 74 6e 61 6d 65 20 22 2c e: " hostname ",
3300: 20 75 73 65 72 6e 61 6d 65 3a 20 22 20 75 73 65 username: " use
3310: 72 6e 61 6d 65 29 0a 20 20 20 20 28 73 71 6c 69 rname). (sqli
3320: 74 65 33 3a 65 78 65 63 75 74 65 20 6d 64 62 20 te3:execute mdb
3330: 22 49 4e 53 45 52 54 20 49 4e 54 4f 20 6d 6f 6e "INSERT INTO mon
3340: 69 74 6f 72 73 20 28 70 69 64 2c 73 74 61 72 74 itors (pid,start
3350: 5f 74 69 6d 65 2c 6c 61 73 74 5f 75 70 64 61 74 _time,last_updat
3360: 65 2c 68 6f 73 74 6e 61 6d 65 2c 75 73 65 72 6e e,hostname,usern
3370: 61 6d 65 29 20 56 41 4c 55 45 53 20 28 3f 2c 73 ame) VALUES (?,s
3380: 74 72 66 74 69 6d 65 28 27 25 73 27 2c 27 6e 6f trftime('%s','no
3390: 77 27 29 2c 73 74 72 66 74 69 6d 65 28 27 25 73 w'),strftime('%s
33a0: 27 2c 27 6e 6f 77 27 29 2c 3f 2c 3f 29 3b 22 0a ','now'),?,?);".
33b0: 09 09 20 20 20 20 20 70 69 64 20 68 6f 73 74 6e .. pid hostn
33c0: 61 6d 65 20 75 73 65 72 6e 61 6d 65 29 29 29 0a ame username))).
33d0: 0a 28 64 65 66 69 6e 65 20 28 74 61 73 6b 73 3a .(define (tasks:
33e0: 67 65 74 2d 6e 75 6d 2d 61 6c 69 76 65 2d 6d 6f get-num-alive-mo
33f0: 6e 69 74 6f 72 73 20 6d 64 62 29 0a 20 20 28 6c nitors mdb). (l
3400: 65 74 20 28 28 72 65 73 20 30 29 29 0a 20 20 20 et ((res 0)).
3410: 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 (sqlite3:for-ea
3420: 63 68 2d 72 6f 77 20 0a 20 20 20 20 20 28 6c 61 ch-row . (la
3430: 6d 62 64 61 20 28 63 6f 75 6e 74 29 0a 20 20 20 mbda (count).
3440: 20 20 20 20 28 73 65 74 21 20 72 65 73 20 63 6f (set! res co
3450: 75 6e 74 29 29 0a 20 20 20 20 20 6d 64 62 0a 20 unt)). mdb.
3460: 20 20 20 20 22 53 45 4c 45 43 54 20 63 6f 75 6e "SELECT coun
3470: 74 28 69 64 29 20 46 52 4f 4d 20 6d 6f 6e 69 74 t(id) FROM monit
3480: 6f 72 73 20 57 48 45 52 45 20 6c 61 73 74 5f 75 ors WHERE last_u
3490: 70 64 61 74 65 20 3c 20 28 73 74 72 66 74 69 6d pdate < (strftim
34a0: 65 28 27 25 73 27 2c 27 6e 6f 77 27 29 20 2d 20 e('%s','now') -
34b0: 33 30 30 29 20 41 4e 44 20 75 73 65 72 6e 61 6d 300) AND usernam
34c0: 65 3d 3f 3b 22 0a 20 20 20 20 20 28 63 61 72 20 e=?;". (car
34d0: 28 75 73 65 72 2d 69 6e 66 6f 72 6d 61 74 69 6f (user-informatio
34e0: 6e 20 28 63 75 72 72 65 6e 74 2d 75 73 65 72 2d n (current-user-
34f0: 69 64 29 29 29 29 0a 20 20 20 20 72 65 73 29 29 id)))). res))
3500: 0a 0a 3b 3b 20 72 65 67 69 73 74 65 72 20 61 20 ..;; register a
3510: 74 61 73 6b 0a 28 64 65 66 69 6e 65 20 28 74 61 task.(define (ta
3520: 73 6b 73 3a 61 64 64 20 6d 64 62 20 61 63 74 69 sks:add mdb acti
3530: 6f 6e 20 6f 77 6e 65 72 20 74 61 72 67 65 74 20 on owner target
3540: 72 75 6e 6e 61 6d 65 20 74 65 73 74 70 61 74 74 runname testpatt
3550: 20 70 61 72 61 6d 73 29 0a 20 20 28 73 71 6c 69 params). (sqli
3560: 74 65 33 3a 65 78 65 63 75 74 65 20 6d 64 62 20 te3:execute mdb
3570: 22 49 4e 53 45 52 54 20 49 4e 54 4f 20 74 61 73 "INSERT INTO tas
3580: 6b 73 5f 71 75 65 75 65 20 28 61 63 74 69 6f 6e ks_queue (action
3590: 2c 6f 77 6e 65 72 2c 73 74 61 74 65 2c 74 61 72 ,owner,state,tar
35a0: 67 65 74 2c 6e 61 6d 65 2c 74 65 73 74 70 61 74 get,name,testpat
35b0: 74 2c 70 61 72 61 6d 73 2c 63 72 65 61 74 69 6f t,params,creatio
35c0: 6e 5f 74 69 6d 65 2c 65 78 65 63 75 74 69 6f 6e n_time,execution
35d0: 5f 74 69 6d 65 29 0a 20 20 20 20 20 20 20 20 20 _time).
35e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 56 41 VA
35f0: 4c 55 45 53 20 28 3f 2c 3f 2c 27 6e 65 77 27 2c LUES (?,?,'new',
3600: 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c 73 74 72 66 74 69 ?,?,?,?,?,strfti
3610: 6d 65 28 27 25 73 27 2c 27 6e 6f 77 27 29 2c 30 me('%s','now'),0
3620: 29 3b 22 20 0a 09 09 20 20 20 61 63 74 69 6f 6e );" ... action
3630: 0a 09 09 20 20 20 6f 77 6e 65 72 0a 09 09 20 20 ... owner...
3640: 20 74 61 72 67 65 74 0a 09 09 20 20 20 72 75 6e target... run
3650: 6e 61 6d 65 0a 09 09 20 20 20 74 65 73 74 0a 09 name... test..
3660: 09 20 20 20 69 74 65 6d 0a 09 09 20 20 20 28 69 . item... (i
3670: 66 20 70 61 72 61 6d 73 20 70 61 72 61 6d 73 20 f params params
3680: 22 22 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 "")))..(define (
3690: 6b 65 79 73 3a 6b 65 79 2d 76 61 6c 73 2d 68 61 keys:key-vals-ha
36a0: 73 68 2d 3e 74 61 72 67 65 74 20 6b 65 79 73 20 sh->target keys
36b0: 6b 65 79 2d 70 61 72 61 6d 73 29 0a 20 20 28 6c key-params). (l
36c0: 65 74 20 28 28 74 6d 70 20 28 68 61 73 68 2d 74 et ((tmp (hash-t
36d0: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
36e0: 20 6b 65 79 2d 70 61 72 61 6d 73 20 28 76 65 63 key-params (vec
36f0: 74 6f 72 2d 72 65 66 20 28 63 61 72 20 6b 65 79 tor-ref (car key
3700: 73 29 20 30 29 20 22 22 29 29 29 0a 20 20 20 20 s) 0) ""))).
3710: 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 6b (if (> (length k
3720: 65 79 73 29 20 31 29 0a 09 28 66 6f 72 2d 65 61 eys) 1)..(for-ea
3730: 63 68 20 28 6c 61 6d 62 64 61 20 28 6b 65 79 29 ch (lambda (key)
3740: 0a 09 09 20 20 20 20 28 73 65 74 21 20 74 6d 70 ... (set! tmp
3750: 20 28 63 6f 6e 63 20 74 6d 70 20 22 2f 22 20 28 (conc tmp "/" (
3760: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
3770: 65 66 61 75 6c 74 20 6b 65 79 2d 70 61 72 61 6d efault key-param
3780: 73 20 28 76 65 63 74 6f 72 2d 72 65 66 20 6b 65 s (vector-ref ke
3790: 79 20 30 29 20 22 22 29 29 29 29 0a 09 09 20 20 y 0) ""))))...
37a0: 28 63 64 72 20 6b 65 79 73 29 29 29 0a 20 20 20 (cdr keys))).
37b0: 20 74 6d 70 29 29 0a 09 09 09 09 09 09 09 09 0a tmp))..........
37c0: 3b 3b 20 66 6f 72 20 75 73 65 20 66 72 6f 6d 20 ;; for use from
37d0: 74 68 65 20 67 75 69 0a 28 64 65 66 69 6e 65 20 the gui.(define
37e0: 28 74 61 73 6b 73 3a 61 64 64 2d 66 72 6f 6d 2d (tasks:add-from-
37f0: 70 61 72 61 6d 73 20 6d 64 62 20 61 63 74 69 6f params mdb actio
3800: 6e 20 6b 65 79 73 20 6b 65 79 2d 70 61 72 61 6d n keys key-param
3810: 73 20 76 61 72 2d 70 61 72 61 6d 73 29 0a 20 20 s var-params).
3820: 28 6c 65 74 20 28 28 74 61 72 67 65 74 20 20 20 (let ((target
3830: 20 28 6b 65 79 73 3a 6b 65 79 2d 76 61 6c 73 2d (keys:key-vals-
3840: 68 61 73 68 2d 3e 74 61 72 67 65 74 20 6b 65 79 hash->target key
3850: 73 20 6b 65 79 2d 70 61 72 61 6d 73 29 29 0a 09 s key-params))..
3860: 28 6f 77 6e 65 72 20 20 20 20 20 28 63 61 72 20 (owner (car
3870: 28 75 73 65 72 2d 69 6e 66 6f 72 6d 61 74 69 6f (user-informatio
3880: 6e 20 28 63 75 72 72 65 6e 74 2d 75 73 65 72 2d n (current-user-
3890: 69 64 29 29 29 29 0a 09 28 72 75 6e 6e 61 6d 65 id))))..(runname
38a0: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 (hash-table-r
38b0: 65 66 2f 64 65 66 61 75 6c 74 20 76 61 72 2d 70 ef/default var-p
38c0: 61 72 61 6d 73 20 22 72 75 6e 6e 61 6d 65 22 20 arams "runname"
38d0: 23 66 29 29 0a 09 28 74 65 73 74 70 61 74 74 73 #f))..(testpatts
38e0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
38f0: 2f 64 65 66 61 75 6c 74 20 76 61 72 2d 70 61 72 /default var-par
3900: 61 6d 73 20 22 74 65 73 74 70 61 74 74 73 22 20 ams "testpatts"
3910: 22 25 22 29 29 0a 09 28 70 61 72 61 6d 73 20 20 "%"))..(params
3920: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 (hash-table-re
3930: 66 2f 64 65 66 61 75 6c 74 20 76 61 72 2d 70 61 f/default var-pa
3940: 72 61 6d 73 20 22 70 61 72 61 6d 73 22 20 20 20 rams "params"
3950: 20 22 22 29 29 29 0a 20 20 20 20 28 74 61 73 6b ""))). (task
3960: 73 3a 61 64 64 20 6d 64 62 20 61 63 74 69 6f 6e s:add mdb action
3970: 20 6f 77 6e 65 72 20 74 61 72 67 65 74 20 72 75 owner target ru
3980: 6e 6e 61 6d 65 20 74 65 73 74 70 61 74 74 73 20 nname testpatts
3990: 70 61 72 61 6d 73 29 29 29 0a 0a 3b 3b 20 72 65 params)))..;; re
39a0: 74 75 72 6e 20 6f 6e 65 20 74 61 73 6b 20 66 72 turn one task fr
39b0: 6f 6d 20 74 68 6f 73 65 20 77 68 6f 20 61 72 65 om those who are
39c0: 20 27 6e 65 77 27 20 4f 52 20 27 77 61 69 74 69 'new' OR 'waiti
39d0: 6e 67 27 20 41 4e 44 20 6d 6f 72 65 20 74 68 61 ng' AND more tha
39e0: 6e 20 31 30 73 65 63 20 6f 6c 64 0a 3b 3b 0a 28 n 10sec old.;;.(
39f0: 64 65 66 69 6e 65 20 28 74 61 73 6b 73 3a 73 6e define (tasks:sn
3a00: 61 67 2d 61 2d 74 61 73 6b 20 6d 64 62 29 0a 20 ag-a-task mdb).
3a10: 20 28 6c 65 74 20 28 28 72 65 73 20 20 20 20 23 (let ((res #
3a20: 66 29 0a 09 28 6b 65 79 74 78 74 20 28 63 6f 6e f)..(keytxt (con
3a30: 63 20 28 63 75 72 72 65 6e 74 2d 70 72 6f 63 65 c (current-proce
3a40: 73 73 2d 69 64 29 20 22 2d 22 20 28 67 65 74 2d ss-id) "-" (get-
3a50: 68 6f 73 74 2d 6e 61 6d 65 29 20 22 2d 22 20 28 host-name) "-" (
3a60: 63 61 72 20 28 75 73 65 72 2d 69 6e 66 6f 72 6d car (user-inform
3a70: 61 74 69 6f 6e 20 28 63 75 72 72 65 6e 74 2d 75 ation (current-u
3a80: 73 65 72 2d 69 64 29 29 29 29 29 29 0a 0a 20 20 ser-id))))))..
3a90: 20 20 3b 3b 20 66 69 72 73 74 20 72 61 6e 64 6f ;; first rando
3aa0: 6d 6c 79 20 73 65 74 20 61 20 6e 65 77 20 74 6f mly set a new to
3ab0: 20 70 69 64 2d 68 6f 73 74 6e 61 6d 65 2d 68 6f pid-hostname-ho
3ac0: 73 74 6e 61 6d 65 0a 20 20 20 20 28 73 71 6c 69 stname. (sqli
3ad0: 74 65 33 3a 65 78 65 63 75 74 65 0a 20 20 20 20 te3:execute.
3ae0: 20 6d 64 62 20 0a 20 20 20 20 20 22 55 50 44 41 mdb . "UPDA
3af0: 54 45 20 74 61 73 6b 73 5f 71 75 65 75 65 20 53 TE tasks_queue S
3b00: 45 54 20 6b 65 79 6c 6f 63 6b 3d 3f 20 57 48 45 ET keylock=? WHE
3b10: 52 45 20 69 64 20 49 4e 0a 20 20 20 20 20 20 20 RE id IN.
3b20: 20 28 53 45 4c 45 43 54 20 69 64 20 46 52 4f 4d (SELECT id FROM
3b30: 20 74 61 73 6b 73 5f 71 75 65 75 65 20 0a 20 20 tasks_queue .
3b40: 20 20 20 20 20 20 20 20 20 57 48 45 52 45 20 73 WHERE s
3b50: 74 61 74 65 3d 27 6e 65 77 27 20 4f 52 20 0a 20 tate='new' OR .
3b60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3b70: 28 73 74 61 74 65 3d 27 77 61 69 74 69 6e 67 27 (state='waiting'
3b80: 20 41 4e 44 20 28 73 74 72 66 74 69 6d 65 28 27 AND (strftime('
3b90: 25 73 27 2c 27 6e 6f 77 27 29 2d 65 78 65 63 75 %s','now')-execu
3ba0: 74 69 6f 6e 5f 74 69 6d 65 29 20 3e 20 31 30 29 tion_time) > 10)
3bb0: 20 4f 52 0a 20 20 20 20 20 20 20 20 20 20 20 20 OR.
3bc0: 20 20 20 20 20 73 74 61 74 65 3d 27 72 65 73 65 state='rese
3bd0: 74 27 0a 20 20 20 20 20 20 20 20 20 20 20 4f 52 t'. OR
3be0: 44 45 52 20 42 59 20 52 41 4e 44 4f 4d 28 29 20 DER BY RANDOM()
3bf0: 4c 49 4d 49 54 20 31 29 3b 22 20 6b 65 79 74 78 LIMIT 1);" keytx
3c00: 74 29 0a 0a 20 20 20 20 28 73 71 6c 69 74 65 33 t).. (sqlite3
3c10: 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 20 20 :for-each-row.
3c20: 20 20 20 28 6c 61 6d 62 64 61 20 28 69 64 20 2e (lambda (id .
3c30: 20 72 65 6d 29 0a 20 20 20 20 20 20 20 28 73 65 rem). (se
3c40: 74 21 20 72 65 73 20 28 61 70 70 6c 79 20 76 65 t! res (apply ve
3c50: 63 74 6f 72 20 69 64 20 72 65 6d 29 29 29 0a 20 ctor id rem))).
3c60: 20 20 20 20 6d 64 62 0a 20 20 20 20 20 22 53 45 mdb. "SE
3c70: 4c 45 43 54 20 69 64 2c 61 63 74 69 6f 6e 2c 6f LECT id,action,o
3c80: 77 6e 65 72 2c 73 74 61 74 65 2c 74 61 72 67 65 wner,state,targe
3c90: 74 2c 6e 61 6d 65 2c 74 65 73 74 2c 69 74 65 6d t,name,test,item
3ca0: 2c 70 61 72 61 6d 73 2c 63 72 65 61 74 69 6f 6e ,params,creation
3cb0: 5f 74 69 6d 65 2c 65 78 65 63 75 74 69 6f 6e 5f _time,execution_
3cc0: 74 69 6d 65 20 46 52 4f 4d 20 74 61 73 6b 73 5f time FROM tasks_
3cd0: 71 75 65 75 65 20 57 48 45 52 45 20 6b 65 79 6c queue WHERE keyl
3ce0: 6f 63 6b 3d 3f 20 4f 52 44 45 52 20 42 59 20 65 ock=? ORDER BY e
3cf0: 78 65 63 75 74 69 6f 6e 5f 74 69 6d 65 20 41 53 xecution_time AS
3d00: 43 20 4c 49 4d 49 54 20 31 3b 22 20 6b 65 79 74 C LIMIT 1;" keyt
3d10: 78 74 29 0a 20 20 20 20 28 69 66 20 72 65 73 20 xt). (if res
3d20: 3b 3b 20 79 65 70 2c 20 68 61 76 65 20 77 6f 72 ;; yep, have wor
3d30: 6b 20 74 6f 20 62 65 20 64 6f 6e 65 0a 09 28 62 k to be done..(b
3d40: 65 67 69 6e 0a 09 20 20 28 73 71 6c 69 74 65 33 egin.. (sqlite3
3d50: 3a 65 78 65 63 75 74 65 20 6d 64 62 20 22 55 50 :execute mdb "UP
3d60: 44 41 54 45 20 74 61 73 6b 73 5f 71 75 65 75 65 DATE tasks_queue
3d70: 20 53 45 54 20 73 74 61 74 65 3d 27 69 6e 70 72 SET state='inpr
3d80: 6f 67 72 65 73 73 27 2c 65 78 65 63 75 74 69 6f ogress',executio
3d90: 6e 5f 74 69 6d 65 3d 73 74 72 66 74 69 6d 65 28 n_time=strftime(
3da0: 27 25 73 27 2c 27 6e 6f 77 27 29 20 57 48 45 52 '%s','now') WHER
3db0: 45 20 69 64 3d 3f 3b 22 0a 09 09 09 20 20 20 28 E id=?;".... (
3dc0: 74 61 73 6b 73 3a 74 61 73 6b 2d 67 65 74 2d 69 tasks:task-get-i
3dd0: 64 20 72 65 73 29 29 0a 09 20 20 72 65 73 29 0a d res)).. res).
3de0: 09 23 66 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 .#f)))..(define
3df0: 28 74 61 73 6b 73 3a 72 65 73 65 74 2d 73 74 75 (tasks:reset-stu
3e00: 63 6b 2d 74 61 73 6b 73 20 6d 64 62 29 0a 20 20 ck-tasks mdb).
3e10: 28 6c 65 74 20 28 28 72 65 73 20 27 28 29 29 29 (let ((res '()))
3e20: 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f . (sqlite3:fo
3e30: 72 2d 65 61 63 68 2d 72 6f 77 0a 20 20 20 20 20 r-each-row.
3e40: 28 6c 61 6d 62 64 61 20 28 69 64 20 64 65 6c 74 (lambda (id delt
3e50: 61 29 0a 20 20 20 20 20 20 20 28 73 65 74 21 20 a). (set!
3e60: 72 65 73 20 28 63 6f 6e 73 20 69 64 20 72 65 73 res (cons id res
3e70: 29 29 29 0a 20 20 20 20 20 6d 64 62 0a 20 20 20 ))). mdb.
3e80: 20 20 22 53 45 4c 45 43 54 20 69 64 2c 73 74 72 "SELECT id,str
3e90: 66 74 69 6d 65 28 27 25 73 27 2c 27 6e 6f 77 27 ftime('%s','now'
3ea0: 29 2d 65 78 65 63 75 74 69 6f 6e 5f 74 69 6d 65 )-execution_time
3eb0: 20 41 53 20 64 65 6c 74 61 20 46 52 4f 4d 20 74 AS delta FROM t
3ec0: 61 73 6b 73 5f 71 75 65 75 65 20 57 48 45 52 45 asks_queue WHERE
3ed0: 20 73 74 61 74 65 3d 27 69 6e 70 72 6f 67 72 65 state='inprogre
3ee0: 73 73 27 20 41 4e 44 20 64 65 6c 74 61 3e 37 30 ss' AND delta>70
3ef0: 30 20 4f 52 44 45 52 20 42 59 20 64 65 6c 74 61 0 ORDER BY delta
3f00: 20 44 45 53 43 20 4c 49 4d 49 54 20 32 3b 22 29 DESC LIMIT 2;")
3f10: 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 . (sqlite3:ex
3f20: 65 63 75 74 65 20 0a 20 20 20 20 20 6d 64 62 20 ecute . mdb
3f30: 0a 20 20 20 20 20 28 63 6f 6e 63 20 22 55 50 44 . (conc "UPD
3f40: 41 54 45 20 74 61 73 6b 73 5f 71 75 65 75 65 20 ATE tasks_queue
3f50: 53 45 54 20 73 74 61 74 65 3d 27 72 65 73 65 74 SET state='reset
3f60: 27 20 57 48 45 52 45 20 69 64 20 49 4e 20 28 27 ' WHERE id IN ('
3f70: 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 " (string-inters
3f80: 70 65 72 73 65 20 28 6d 61 70 20 63 6f 6e 63 20 perse (map conc
3f90: 72 65 73 29 20 22 27 2c 27 22 29 20 22 27 29 3b res) "','") "');
3fa0: 22 29 29 29 29 0a 0a 3b 3b 20 72 65 74 75 72 6e "))))..;; return
3fb0: 20 61 6c 6c 20 74 61 73 6b 73 20 69 6e 20 74 68 all tasks in th
3fc0: 65 20 74 61 73 6b 73 5f 71 75 65 75 65 20 74 61 e tasks_queue ta
3fd0: 62 6c 65 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 ble.;;.(define (
3fe0: 74 61 73 6b 73 3a 67 65 74 2d 74 61 73 6b 73 20 tasks:get-tasks
3ff0: 6d 64 62 20 74 79 70 65 73 20 73 74 61 74 65 73 mdb types states
4000: 29 0a 20 20 28 6c 65 74 20 28 28 72 65 73 20 27 ). (let ((res '
4010: 28 29 29 29 0a 20 20 20 20 28 73 71 6c 69 74 65 ())). (sqlite
4020: 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 20 3:for-each-row.
4030: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 69 64 20 (lambda (id
4040: 2e 20 72 65 6d 29 0a 20 20 20 20 20 20 20 28 73 . rem). (s
4050: 65 74 21 20 72 65 73 20 28 63 6f 6e 73 20 28 61 et! res (cons (a
4060: 70 70 6c 79 20 76 65 63 74 6f 72 20 69 64 20 72 pply vector id r
4070: 65 6d 29 20 72 65 73 29 29 29 0a 20 20 20 20 20 em) res))).
4080: 6d 64 62 0a 20 20 20 20 20 28 63 6f 6e 63 20 22 mdb. (conc "
4090: 53 45 4c 45 43 54 20 69 64 2c 61 63 74 69 6f 6e SELECT id,action
40a0: 2c 6f 77 6e 65 72 2c 73 74 61 74 65 2c 74 61 72 ,owner,state,tar
40b0: 67 65 74 2c 6e 61 6d 65 2c 74 65 73 74 2c 69 74 get,name,test,it
40c0: 65 6d 2c 70 61 72 61 6d 73 2c 63 72 65 61 74 69 em,params,creati
40d0: 6f 6e 5f 74 69 6d 65 2c 65 78 65 63 75 74 69 6f on_time,executio
40e0: 6e 5f 74 69 6d 65 20 0a 20 20 20 20 20 20 20 20 n_time .
40f0: 20 20 20 20 20 20 20 46 52 4f 4d 20 74 61 73 6b FROM task
4100: 73 5f 71 75 65 75 65 20 22 0a 20 20 20 20 20 20 s_queue ".
4110: 20 20 20 20 20 20 20 20 20 3b 3b 20 57 48 45 52 ;; WHER
4120: 45 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 E .
4130: 20 20 20 3b 3b 20 20 20 73 74 61 74 65 20 49 4e ;; state IN
4140: 20 22 20 73 74 61 74 65 73 73 74 72 20 22 20 41 " statesstr " A
4150: 4e 44 20 0a 09 20 20 20 20 20 20 20 3b 3b 20 20 ND .. ;;
4160: 20 61 63 74 69 6f 6e 20 49 4e 20 22 20 61 63 74 action IN " act
4170: 69 6f 6e 73 73 74 72 20 0a 09 20 20 20 22 20 4f ionsstr .. " O
4180: 52 44 45 52 20 42 59 20 63 72 65 61 74 69 6f 6e RDER BY creation
4190: 5f 74 69 6d 65 20 44 45 53 43 3b 22 29 29 0a 20 _time DESC;")).
41a0: 20 20 20 72 65 73 29 29 0a 0a 3b 3b 20 72 65 6d res))..;; rem
41b0: 6f 76 65 20 74 61 73 6b 73 20 67 69 76 65 6e 20 ove tasks given
41c0: 62 79 20 61 20 73 74 72 69 6e 67 20 6f 66 20 6e by a string of n
41d0: 75 6d 62 65 72 73 20 63 6f 6d 6d 61 20 73 65 70 umbers comma sep
41e0: 61 72 61 74 65 64 0a 28 64 65 66 69 6e 65 20 28 arated.(define (
41f0: 74 61 73 6b 73 3a 72 65 6d 6f 76 65 2d 71 75 65 tasks:remove-que
4200: 75 65 2d 65 6e 74 72 69 65 73 20 6d 64 62 20 74 ue-entries mdb t
4210: 61 73 6b 2d 69 64 73 29 0a 20 20 28 73 71 6c 69 ask-ids). (sqli
4220: 74 65 33 3a 65 78 65 63 75 74 65 20 6d 64 62 20 te3:execute mdb
4230: 28 63 6f 6e 63 20 22 44 45 4c 45 54 45 20 46 52 (conc "DELETE FR
4240: 4f 4d 20 74 61 73 6b 73 5f 71 75 65 75 65 20 57 OM tasks_queue W
4250: 48 45 52 45 20 69 64 20 49 4e 20 28 22 20 74 61 HERE id IN (" ta
4260: 73 6b 2d 69 64 73 20 22 29 3b 22 29 29 29 0a 0a sk-ids ");")))..
4270: 3b 3b 20 0a 28 64 65 66 69 6e 65 20 28 74 61 73 ;; .(define (tas
4280: 6b 73 3a 73 74 61 72 74 2d 6d 6f 6e 69 74 6f 72 ks:start-monitor
4290: 20 64 62 20 6d 64 62 29 0a 20 20 28 69 66 20 28 db mdb). (if (
42a0: 3e 20 28 74 61 73 6b 73 3a 67 65 74 2d 6e 75 6d > (tasks:get-num
42b0: 2d 61 6c 69 76 65 2d 6d 6f 6e 69 74 6f 72 73 20 -alive-monitors
42c0: 6d 64 62 29 20 32 29 20 3b 3b 20 68 61 76 65 20 mdb) 2) ;; have
42d0: 74 77 6f 20 72 75 6e 6e 69 6e 67 2c 20 6e 6f 20 two running, no
42e0: 6e 65 65 64 20 66 6f 72 20 6d 6f 72 65 0a 20 20 need for more.
42f0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
4300: 2d 69 6e 66 6f 20 31 20 22 4e 6f 74 20 73 74 61 -info 1 "Not sta
4310: 72 74 69 6e 67 20 6d 6f 6e 69 74 6f 72 2c 20 61 rting monitor, a
4320: 6c 72 65 61 64 79 20 68 61 76 65 20 6d 6f 72 65 lready have more
4330: 20 74 68 61 6e 20 74 77 6f 20 72 75 6e 6e 69 6e than two runnin
4340: 67 22 29 0a 20 20 20 20 20 20 28 6c 65 74 2a 20 g"). (let*
4350: 28 28 6d 65 67 61 74 65 73 74 64 62 20 20 20 20 ((megatestdb
4360: 20 28 63 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a (conc *toppath*
4370: 20 22 2f 6d 65 67 61 74 65 73 74 2e 64 62 22 29 "/megatest.db")
4380: 29 0a 09 20 20 20 20 20 28 6d 6f 6e 69 74 6f 72 ).. (monitor
4390: 64 62 66 20 20 20 20 20 28 63 6f 6e 63 20 2a 74 dbf (conc *t
43a0: 6f 70 70 61 74 68 2a 20 22 2f 64 62 2f 6d 6f 6e oppath* "/db/mon
43b0: 69 74 6f 72 2e 64 62 22 29 29 0a 09 20 20 20 20 itor.db"))..
43c0: 20 28 6c 61 73 74 2d 64 62 2d 75 70 64 61 74 65 (last-db-update
43d0: 20 30 29 29 20 3b 3b 20 28 66 69 6c 65 2d 6d 6f 0)) ;; (file-mo
43e0: 64 69 66 69 63 61 74 69 6f 6e 2d 74 69 6d 65 20 dification-time
43f0: 6d 65 67 61 74 65 73 74 64 62 29 29 29 0a 09 28 megatestdb)))..(
4400: 74 61 73 6b 3a 72 65 67 69 73 74 65 72 2d 6d 6f task:register-mo
4410: 6e 69 74 6f 72 20 6d 64 62 29 0a 09 28 6c 65 74 nitor mdb)..(let
4420: 20 6c 6f 6f 70 20 28 28 63 6f 75 6e 74 20 20 20 loop ((count
4430: 20 20 20 30 29 0a 09 09 20 20 20 28 6e 65 78 74 0)... (next
4440: 2d 74 6f 75 63 68 20 30 29 29 20 3b 3b 20 6e 65 -touch 0)) ;; ne
4450: 78 74 2d 74 6f 75 63 68 20 69 73 20 74 68 65 20 xt-touch is the
4460: 74 69 6d 65 20 77 68 65 72 65 20 77 65 20 6e 65 time where we ne
4470: 65 64 20 74 6f 20 75 70 64 61 74 65 20 6c 61 73 ed to update las
4480: 74 5f 75 70 64 61 74 65 0a 09 20 20 3b 3b 20 69 t_update.. ;; i
4490: 66 20 74 68 65 20 64 62 20 68 61 73 20 62 65 65 f the db has bee
44a0: 6e 20 6d 6f 64 69 66 69 65 64 20 77 65 27 64 20 n modified we'd
44b0: 62 65 73 74 20 6c 6f 6f 6b 20 61 74 20 74 68 65 best look at the
44c0: 20 74 61 73 6b 20 71 75 65 75 65 0a 09 20 20 28 task queue.. (
44d0: 6c 65 74 20 28 28 6d 6f 64 74 69 6d 65 20 28 66 let ((modtime (f
44e0: 69 6c 65 2d 6d 6f 64 69 66 69 63 61 74 69 6f 6e ile-modification
44f0: 2d 74 69 6d 65 20 6d 65 67 61 74 65 73 74 64 62 -time megatestdb
4500: 70 61 74 68 20 29 29 29 0a 09 20 20 20 20 28 69 path ))).. (i
4510: 66 20 28 3e 20 6d 6f 64 74 69 6d 65 20 6c 61 73 f (> modtime las
4520: 74 2d 64 62 2d 75 70 64 61 74 65 29 0a 09 09 28 t-db-update)...(
4530: 74 61 73 6b 73 3a 70 72 6f 63 65 73 73 2d 71 75 tasks:process-qu
4540: 65 75 65 20 64 62 20 6d 64 62 20 6c 61 73 74 2d eue db mdb last-
4550: 64 62 2d 75 70 64 61 74 65 20 6d 65 67 61 74 65 db-update megate
4560: 73 74 64 62 20 6e 65 78 74 2d 74 6f 75 63 68 29 stdb next-touch)
4570: 29 0a 09 20 20 20 20 3b 3b 20 57 41 52 4e 49 4e ).. ;; WARNIN
4580: 47 3a 20 50 6f 73 73 69 62 6c 65 20 72 61 63 65 G: Possible race
4590: 20 63 6f 6e 64 69 74 6f 6e 20 68 65 72 65 21 21 conditon here!!
45a0: 0a 09 20 20 20 20 3b 3b 20 73 68 6f 75 6c 64 20 .. ;; should
45b0: 74 68 69 73 20 75 70 64 61 74 65 20 62 65 20 69 this update be i
45c0: 6d 6d 65 64 69 61 74 65 6c 79 20 61 66 74 65 72 mmediately after
45d0: 20 74 68 65 20 74 61 73 6b 2d 67 65 74 2d 61 63 the task-get-ac
45e0: 74 69 6f 6e 20 63 61 6c 6c 20 61 62 6f 76 65 3f tion call above?
45f0: 0a 09 20 20 20 20 28 69 66 20 28 3e 20 28 63 75 .. (if (> (cu
4600: 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 20 6e rrent-seconds) n
4610: 65 78 74 2d 74 6f 75 63 68 29 0a 09 09 28 62 65 ext-touch)...(be
4620: 67 69 6e 0a 09 09 20 20 28 74 61 73 6b 73 3a 6d gin... (tasks:m
4630: 6f 6e 69 74 6f 72 73 2d 75 70 64 61 74 65 20 6d onitors-update m
4640: 64 62 29 0a 09 09 20 20 28 6c 6f 6f 70 20 28 2b db)... (loop (+
4650: 20 63 6f 75 6e 74 20 31 29 28 2b 20 28 63 75 72 count 1)(+ (cur
4660: 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 20 32 34 rent-seconds) 24
4670: 30 29 29 29 0a 09 09 28 6c 6f 6f 70 20 28 2b 20 0)))...(loop (+
4680: 63 6f 75 6e 74 20 31 29 20 6e 65 78 74 2d 74 6f count 1) next-to
4690: 75 63 68 29 29 29 29 29 29 29 0a 20 20 20 20 20 uch))))))).
46a0: 20 0a 28 64 65 66 69 6e 65 20 28 74 61 73 6b 73 .(define (tasks
46b0: 3a 70 72 6f 63 65 73 73 2d 71 75 65 75 65 20 64 :process-queue d
46c0: 62 20 6d 64 62 29 0a 20 20 28 6c 65 74 2a 20 28 b mdb). (let* (
46d0: 28 74 61 73 6b 20 20 20 28 74 61 73 6b 73 3a 73 (task (tasks:s
46e0: 6e 61 67 2d 61 2d 74 61 73 6b 20 6d 64 62 29 29 nag-a-task mdb))
46f0: 0a 09 20 28 61 63 74 69 6f 6e 20 28 69 66 20 74 .. (action (if t
4700: 61 73 6b 20 28 74 61 73 6b 73 3a 74 61 73 6b 2d ask (tasks:task-
4710: 67 65 74 2d 61 63 74 69 6f 6e 20 74 61 73 6b 29 get-action task)
4720: 20 23 66 29 29 29 0a 20 20 20 20 28 69 66 20 61 #f))). (if a
4730: 63 74 69 6f 6e 20 28 70 72 69 6e 74 20 22 74 61 ction (print "ta
4740: 73 6b 73 3a 70 72 6f 63 65 73 73 2d 71 75 65 75 sks:process-queu
4750: 65 20 74 61 73 6b 3a 20 22 20 74 61 73 6b 29 29 e task: " task))
4760: 0a 20 20 20 20 28 69 66 20 61 63 74 69 6f 6e 0a . (if action.
4770: 09 28 63 61 73 65 20 28 73 74 72 69 6e 67 2d 3e .(case (string->
4780: 73 79 6d 62 6f 6c 20 61 63 74 69 6f 6e 29 0a 09 symbol action)..
4790: 20 20 28 28 72 75 6e 29 20 20 20 20 20 20 20 28 ((run) (
47a0: 74 61 73 6b 73 3a 73 74 61 72 74 2d 72 75 6e 20 tasks:start-run
47b0: 20 20 64 62 20 6d 64 62 20 74 61 73 6b 29 29 0a db mdb task)).
47c0: 09 20 20 28 28 72 65 6d 6f 76 65 29 20 20 20 20 . ((remove)
47d0: 28 74 61 73 6b 73 3a 72 65 6d 6f 76 65 2d 72 75 (tasks:remove-ru
47e0: 6e 73 20 64 62 20 6d 64 62 20 74 61 73 6b 29 29 ns db mdb task))
47f0: 0a 09 20 20 28 28 6c 6f 63 6b 29 20 20 20 20 20 .. ((lock)
4800: 20 28 74 61 73 6b 73 3a 6c 6f 63 6b 2d 72 75 6e (tasks:lock-run
4810: 73 20 20 20 64 62 20 6d 64 62 20 74 61 73 6b 29 s db mdb task)
4820: 29 0a 09 20 20 3b 3b 20 28 28 6d 6f 6e 69 74 6f ).. ;; ((monito
4830: 72 29 20 20 20 28 74 61 73 6b 73 3a 73 74 61 72 r) (tasks:star
4840: 74 2d 6d 6f 6e 69 74 6f 72 20 64 62 20 74 61 73 t-monitor db tas
4850: 6b 29 29 0a 09 20 20 28 28 72 6f 6c 6c 75 70 29 k)).. ((rollup)
4860: 20 20 20 20 28 74 61 73 6b 73 3a 72 6f 6c 6c 75 (tasks:rollu
4870: 70 2d 72 75 6e 73 20 64 62 20 6d 64 62 20 74 61 p-runs db mdb ta
4880: 73 6b 29 29 0a 09 20 20 28 28 75 70 64 61 74 65 sk)).. ((update
4890: 6d 65 74 61 29 28 74 61 73 6b 73 3a 75 70 64 61 meta)(tasks:upda
48a0: 74 65 2d 6d 65 74 61 20 64 62 20 6d 64 62 20 74 te-meta db mdb t
48b0: 61 73 6b 29 29 0a 09 20 20 28 28 6b 69 6c 6c 29 ask)).. ((kill)
48c0: 20 20 20 20 20 20 28 74 61 73 6b 73 3a 6b 69 6c (tasks:kil
48d0: 6c 2d 6d 6f 6e 69 74 6f 72 73 20 64 62 20 6d 64 l-monitors db md
48e0: 62 20 74 61 73 6b 29 29 29 29 29 29 0a 0a 28 64 b task))))))..(d
48f0: 65 66 69 6e 65 20 28 74 61 73 6b 73 3a 67 65 74 efine (tasks:get
4900: 2d 6d 6f 6e 69 74 6f 72 73 20 6d 64 62 29 0a 20 -monitors mdb).
4910: 20 28 6c 65 74 20 28 28 72 65 73 20 27 28 29 29 (let ((res '())
4920: 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 ). (sqlite3:f
4930: 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 20 20 20 20 or-each-row.
4940: 20 28 6c 61 6d 62 64 61 20 28 61 20 2e 20 72 65 (lambda (a . re
4950: 6d 29 0a 20 20 20 20 20 20 20 28 73 65 74 21 20 m). (set!
4960: 72 65 73 20 28 63 6f 6e 73 20 28 61 70 70 6c 79 res (cons (apply
4970: 20 76 65 63 74 6f 72 20 61 20 72 65 6d 29 20 72 vector a rem) r
4980: 65 73 29 29 29 0a 20 20 20 20 20 6d 64 62 0a 20 es))). mdb.
4990: 20 20 20 20 22 53 45 4c 45 43 54 20 69 64 2c 70 "SELECT id,p
49a0: 69 64 2c 73 74 72 66 74 69 6d 65 28 27 25 6d 2f id,strftime('%m/
49b0: 25 64 2f 25 59 20 25 48 3a 25 4d 27 2c 64 61 74 %d/%Y %H:%M',dat
49c0: 65 74 69 6d 65 28 73 74 61 72 74 5f 74 69 6d 65 etime(start_time
49d0: 2c 27 75 6e 69 78 65 70 6f 63 68 27 29 2c 27 6c ,'unixepoch'),'l
49e0: 6f 63 61 6c 74 69 6d 65 27 29 2c 73 74 72 66 74 ocaltime'),strft
49f0: 69 6d 65 28 27 25 6d 2f 25 64 2f 25 59 20 25 48 ime('%m/%d/%Y %H
4a00: 3a 25 4d 3a 25 53 27 2c 64 61 74 65 74 69 6d 65 :%M:%S',datetime
4a10: 28 6c 61 73 74 5f 75 70 64 61 74 65 2c 27 75 6e (last_update,'un
4a20: 69 78 65 70 6f 63 68 27 29 2c 27 6c 6f 63 61 6c ixepoch'),'local
4a30: 74 69 6d 65 27 29 2c 68 6f 73 74 6e 61 6d 65 2c time'),hostname,
4a40: 75 73 65 72 6e 61 6d 65 20 46 52 4f 4d 20 6d 6f username FROM mo
4a50: 6e 69 74 6f 72 73 20 4f 52 44 45 52 20 42 59 20 nitors ORDER BY
4a60: 6c 61 73 74 5f 75 70 64 61 74 65 20 41 53 43 3b last_update ASC;
4a70: 22 29 0a 20 20 20 20 28 72 65 76 65 72 73 65 20 "). (reverse
4a80: 72 65 73 29 0a 20 20 20 20 29 29 0a 0a 28 64 65 res). ))..(de
4a90: 66 69 6e 65 20 28 74 61 73 6b 73 3a 74 61 73 6b fine (tasks:task
4aa0: 73 2d 3e 74 65 78 74 20 74 61 73 6b 73 29 0a 20 s->text tasks).
4ab0: 20 28 6c 65 74 20 28 28 66 6d 74 73 74 72 20 22 (let ((fmtstr "
4ac0: 7e 31 30 61 7e 31 30 61 7e 31 30 61 7e 31 32 61 ~10a~10a~10a~12a
4ad0: 7e 32 30 61 7e 31 32 61 7e 31 32 61 7e 31 30 61 ~20a~12a~12a~10a
4ae0: 22 29 29 0a 20 20 20 20 28 63 6f 6e 63 20 28 66 ")). (conc (f
4af0: 6f 72 6d 61 74 20 23 66 20 66 6d 74 73 74 72 20 ormat #f fmtstr
4b00: 22 69 64 22 20 22 61 63 74 69 6f 6e 22 20 22 6f "id" "action" "o
4b10: 77 6e 65 72 22 20 22 73 74 61 74 65 22 20 22 74 wner" "state" "t
4b20: 61 72 67 65 74 22 20 22 72 75 6e 6e 61 6d 65 22 arget" "runname"
4b30: 20 22 74 65 73 74 70 61 74 74 73 22 20 22 70 61 "testpatts" "pa
4b40: 72 61 6d 73 22 29 20 22 5c 6e 22 0a 09 20 20 28 rams") "\n".. (
4b50: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
4b60: 73 65 20 0a 09 20 20 20 28 6d 61 70 20 28 6c 61 se .. (map (la
4b70: 6d 62 64 61 20 28 74 61 73 6b 29 0a 09 09 20 20 mbda (task)...
4b80: 28 66 6f 72 6d 61 74 20 23 66 20 66 6d 74 73 74 (format #f fmtst
4b90: 72 0a 09 09 09 20 20 28 74 61 73 6b 73 3a 74 61 r.... (tasks:ta
4ba0: 73 6b 2d 67 65 74 2d 69 64 20 20 20 20 20 74 61 sk-get-id ta
4bb0: 73 6b 29 0a 09 09 09 20 20 28 74 61 73 6b 73 3a sk).... (tasks:
4bc0: 74 61 73 6b 2d 67 65 74 2d 61 63 74 69 6f 6e 20 task-get-action
4bd0: 74 61 73 6b 29 0a 09 09 09 20 20 28 74 61 73 6b task).... (task
4be0: 73 3a 74 61 73 6b 2d 67 65 74 2d 6f 77 6e 65 72 s:task-get-owner
4bf0: 20 20 74 61 73 6b 29 0a 09 09 09 20 20 28 74 61 task).... (ta
4c00: 73 6b 73 3a 74 61 73 6b 2d 67 65 74 2d 73 74 61 sks:task-get-sta
4c10: 74 65 20 20 74 61 73 6b 29 0a 09 09 09 20 20 28 te task).... (
4c20: 74 61 73 6b 73 3a 74 61 73 6b 2d 67 65 74 2d 74 tasks:task-get-t
4c30: 61 72 67 65 74 20 74 61 73 6b 29 0a 09 09 09 20 arget task)....
4c40: 20 28 74 61 73 6b 73 3a 74 61 73 6b 2d 67 65 74 (tasks:task-get
4c50: 2d 6e 61 6d 65 20 20 20 74 61 73 6b 29 0a 09 09 -name task)...
4c60: 09 20 20 28 74 61 73 6b 73 3a 74 61 73 6b 2d 67 . (tasks:task-g
4c70: 65 74 2d 74 65 73 74 20 20 20 74 61 73 6b 29 0a et-test task).
4c80: 09 09 09 20 20 3b 3b 20 28 74 61 73 6b 73 3a 74 ... ;; (tasks:t
4c90: 61 73 6b 2d 67 65 74 2d 69 74 65 6d 20 20 20 74 ask-get-item t
4ca0: 61 73 6b 29 0a 09 09 09 20 20 28 74 61 73 6b 73 ask).... (tasks
4cb0: 3a 74 61 73 6b 2d 67 65 74 2d 70 61 72 61 6d 73 :task-get-params
4cc0: 20 74 61 73 6b 29 29 29 0a 09 09 74 61 73 6b 73 task)))...tasks
4cd0: 29 20 22 5c 6e 22 29 29 29 29 0a 20 20 20 0a 28 ) "\n")))). .(
4ce0: 64 65 66 69 6e 65 20 28 74 61 73 6b 73 3a 6d 6f define (tasks:mo
4cf0: 6e 69 74 6f 72 73 2d 3e 74 65 78 74 2d 74 61 62 nitors->text-tab
4d00: 6c 65 20 6d 6f 6e 69 74 6f 72 73 29 0a 20 20 28 le monitors). (
4d10: 6c 65 74 20 28 28 66 6d 74 73 74 72 20 22 7e 34 let ((fmtstr "~4
4d20: 61 7e 38 61 7e 32 30 61 7e 32 30 61 7e 31 30 61 a~8a~20a~20a~10a
4d30: 7e 31 30 61 22 29 29 0a 20 20 20 20 28 63 6f 6e ~10a")). (con
4d40: 63 20 28 66 6f 72 6d 61 74 20 23 66 20 66 6d 74 c (format #f fmt
4d50: 73 74 72 20 22 69 64 22 20 22 70 69 64 22 20 22 str "id" "pid" "
4d60: 73 74 61 72 74 20 74 69 6d 65 22 20 22 6c 61 73 start time" "las
4d70: 74 20 75 70 64 61 74 65 22 20 22 68 6f 73 74 6e t update" "hostn
4d80: 61 6d 65 22 20 22 75 73 65 72 22 29 20 22 5c 6e ame" "user") "\n
4d90: 22 0a 09 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 ".. (string-int
4da0: 65 72 73 70 65 72 73 65 20 0a 09 20 20 20 28 6d ersperse .. (m
4db0: 61 70 20 28 6c 61 6d 62 64 61 20 28 6d 6f 6e 69 ap (lambda (moni
4dc0: 74 6f 72 29 0a 09 09 20 20 28 66 6f 72 6d 61 74 tor)... (format
4dd0: 20 23 66 20 66 6d 74 73 74 72 0a 09 09 09 20 20 #f fmtstr....
4de0: 28 74 61 73 6b 73 3a 6d 6f 6e 69 74 6f 72 2d 67 (tasks:monitor-g
4df0: 65 74 2d 69 64 20 20 20 20 20 20 20 20 20 20 6d et-id m
4e00: 6f 6e 69 74 6f 72 29 0a 09 09 09 20 20 28 74 61 onitor).... (ta
4e10: 73 6b 73 3a 6d 6f 6e 69 74 6f 72 2d 67 65 74 2d sks:monitor-get-
4e20: 70 69 64 20 20 20 20 20 20 20 20 20 6d 6f 6e 69 pid moni
4e30: 74 6f 72 29 0a 09 09 09 20 20 28 74 61 73 6b 73 tor).... (tasks
4e40: 3a 6d 6f 6e 69 74 6f 72 2d 67 65 74 2d 73 74 61 :monitor-get-sta
4e50: 72 74 5f 74 69 6d 65 20 20 6d 6f 6e 69 74 6f 72 rt_time monitor
4e60: 29 0a 09 09 09 20 20 28 74 61 73 6b 73 3a 6d 6f ).... (tasks:mo
4e70: 6e 69 74 6f 72 2d 67 65 74 2d 6c 61 73 74 5f 75 nitor-get-last_u
4e80: 70 64 61 74 65 20 6d 6f 6e 69 74 6f 72 29 0a 09 pdate monitor)..
4e90: 09 09 20 20 28 74 61 73 6b 73 3a 6d 6f 6e 69 74 .. (tasks:monit
4ea0: 6f 72 2d 67 65 74 2d 68 6f 73 74 6e 61 6d 65 20 or-get-hostname
4eb0: 20 20 20 6d 6f 6e 69 74 6f 72 29 0a 09 09 09 20 monitor)....
4ec0: 20 28 74 61 73 6b 73 3a 6d 6f 6e 69 74 6f 72 2d (tasks:monitor-
4ed0: 67 65 74 2d 75 73 65 72 6e 61 6d 65 20 20 20 20 get-username
4ee0: 6d 6f 6e 69 74 6f 72 29 29 29 0a 09 09 6d 6f 6e monitor)))...mon
4ef0: 69 74 6f 72 73 29 0a 09 20 20 20 22 5c 6e 22 29 itors).. "\n")
4f00: 29 29 29 0a 20 20 20 0a 3b 3b 20 75 70 64 61 74 ))). .;; updat
4f10: 65 20 74 68 65 20 6c 61 73 74 5f 75 70 64 61 74 e the last_updat
4f20: 65 20 66 69 65 6c 64 20 77 69 74 68 20 74 68 65 e field with the
4f30: 20 63 75 72 72 65 6e 74 20 74 69 6d 65 20 61 6e current time an
4f40: 64 0a 3b 3b 20 69 66 20 61 6e 79 20 6d 6f 6e 69 d.;; if any moni
4f50: 74 6f 72 73 20 61 70 70 65 61 72 20 64 65 61 64 tors appear dead
4f60: 2c 20 72 65 6d 6f 76 65 20 74 68 65 6d 0a 28 64 , remove them.(d
4f70: 65 66 69 6e 65 20 28 74 61 73 6b 73 3a 6d 6f 6e efine (tasks:mon
4f80: 69 74 6f 72 73 2d 75 70 64 61 74 65 20 6d 64 62 itors-update mdb
4f90: 29 0a 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 ). (sqlite3:exe
4fa0: 63 75 74 65 20 6d 64 62 20 22 55 50 44 41 54 45 cute mdb "UPDATE
4fb0: 20 6d 6f 6e 69 74 6f 72 73 20 53 45 54 20 6c 61 monitors SET la
4fc0: 73 74 5f 75 70 64 61 74 65 3d 73 74 72 66 74 69 st_update=strfti
4fd0: 6d 65 28 27 25 73 27 2c 27 6e 6f 77 27 29 20 57 me('%s','now') W
4fe0: 48 45 52 45 20 70 69 64 3d 3f 20 41 4e 44 20 68 HERE pid=? AND h
4ff0: 6f 73 74 6e 61 6d 65 3d 3f 3b 22 0a 09 09 09 20 ostname=?;"....
5000: 20 28 63 75 72 72 65 6e 74 2d 70 72 6f 63 65 73 (current-proces
5010: 73 2d 69 64 29 0a 09 09 09 20 20 28 67 65 74 2d s-id).... (get-
5020: 68 6f 73 74 2d 6e 61 6d 65 29 29 0a 20 20 28 6c host-name)). (l
5030: 65 74 20 28 28 64 65 61 64 6c 69 73 74 20 27 28 et ((deadlist '(
5040: 29 29 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 ))). (sqlite3
5050: 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 20 20 :for-each-row.
5060: 20 20 20 28 6c 61 6d 62 64 61 20 28 69 64 20 70 (lambda (id p
5070: 69 64 20 68 6f 73 74 20 6c 61 73 74 2d 75 70 64 id host last-upd
5080: 61 74 65 20 64 65 6c 74 61 29 0a 20 20 20 20 20 ate delta).
5090: 20 20 28 70 72 69 6e 74 20 22 47 6f 69 6e 67 20 (print "Going
50a0: 74 6f 20 64 65 6c 65 74 65 20 73 74 61 6c 65 20 to delete stale
50b0: 72 65 63 6f 72 64 20 66 6f 72 20 6d 6f 6e 69 74 record for monit
50c0: 6f 72 20 77 69 74 68 20 70 69 64 20 22 20 70 69 or with pid " pi
50d0: 64 20 22 20 6f 6e 20 68 6f 73 74 20 22 20 68 6f d " on host " ho
50e0: 73 74 20 22 20 6c 61 73 74 20 75 70 64 61 74 65 st " last update
50f0: 64 20 22 20 64 65 6c 74 61 20 22 20 73 65 63 6f d " delta " seco
5100: 6e 64 73 20 61 67 6f 22 29 0a 20 20 20 20 20 20 nds ago").
5110: 20 28 73 65 74 21 20 64 65 61 64 6c 69 73 74 20 (set! deadlist
5120: 28 63 6f 6e 73 20 69 64 20 64 65 61 64 6c 69 73 (cons id deadlis
5130: 74 29 29 29 0a 20 20 20 20 20 6d 64 62 20 0a 20 t))). mdb .
5140: 20 20 20 20 22 53 45 4c 45 43 54 20 69 64 2c 70 "SELECT id,p
5150: 69 64 2c 68 6f 73 74 6e 61 6d 65 2c 6c 61 73 74 id,hostname,last
5160: 5f 75 70 64 61 74 65 2c 73 74 72 66 74 69 6d 65 _update,strftime
5170: 28 27 25 73 27 2c 27 6e 6f 77 27 29 2d 6c 61 73 ('%s','now')-las
5180: 74 5f 75 70 64 61 74 65 20 41 53 20 64 65 6c 74 t_update AS delt
5190: 61 20 46 52 4f 4d 20 6d 6f 6e 69 74 6f 72 73 20 a FROM monitors
51a0: 57 48 45 52 45 20 64 65 6c 74 61 20 3e 20 37 30 WHERE delta > 70
51b0: 30 3b 22 29 0a 20 20 20 20 28 73 71 6c 69 74 65 0;"). (sqlite
51c0: 33 3a 65 78 65 63 75 74 65 20 6d 64 62 20 28 63 3:execute mdb (c
51d0: 6f 6e 63 20 22 44 45 4c 45 54 45 20 46 52 4f 4d onc "DELETE FROM
51e0: 20 6d 6f 6e 69 74 6f 72 73 20 57 48 45 52 45 20 monitors WHERE
51f0: 69 64 20 49 4e 20 28 27 22 20 28 73 74 72 69 6e id IN ('" (strin
5200: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 6d g-intersperse (m
5210: 61 70 20 63 6f 6e 63 20 64 65 61 64 6c 69 73 74 ap conc deadlist
5220: 29 20 22 27 2c 27 22 29 20 22 27 29 3b 22 29 29 ) "','") "');"))
5230: 29 0a 20 20 29 0a 0a 28 64 65 66 69 6e 65 20 28 ). )..(define (
5240: 74 61 73 6b 73 3a 72 65 6d 6f 76 65 2d 6d 6f 6e tasks:remove-mon
5250: 69 74 6f 72 2d 72 65 63 6f 72 64 20 6d 64 62 29 itor-record mdb)
5260: 0a 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 . (sqlite3:exec
5270: 75 74 65 20 6d 64 62 20 22 44 45 4c 45 54 45 20 ute mdb "DELETE
5280: 46 52 4f 4d 20 6d 6f 6e 69 74 6f 72 73 20 57 48 FROM monitors WH
5290: 45 52 45 20 70 69 64 3d 3f 20 41 4e 44 20 68 6f ERE pid=? AND ho
52a0: 73 74 6e 61 6d 65 3d 3f 3b 22 0a 09 09 20 20 20 stname=?;"...
52b0: 28 63 75 72 72 65 6e 74 2d 70 72 6f 63 65 73 73 (current-process
52c0: 2d 69 64 29 0a 09 09 20 20 20 28 67 65 74 2d 68 -id)... (get-h
52d0: 6f 73 74 2d 6e 61 6d 65 29 29 29 0a 0a 28 64 65 ost-name)))..(de
52e0: 66 69 6e 65 20 28 74 61 73 6b 73 3a 73 65 74 2d fine (tasks:set-
52f0: 73 74 61 74 65 20 6d 64 62 20 74 61 73 6b 2d 69 state mdb task-i
5300: 64 20 73 74 61 74 65 29 0a 20 20 28 73 71 6c 69 d state). (sqli
5310: 74 65 33 3a 65 78 65 63 75 74 65 20 6d 64 62 20 te3:execute mdb
5320: 22 55 50 44 41 54 45 20 74 61 73 6b 73 5f 71 75 "UPDATE tasks_qu
5330: 65 75 65 20 53 45 54 20 73 74 61 74 65 3d 3f 20 eue SET state=?
5340: 57 48 45 52 45 20 69 64 3d 3f 3b 22 20 0a 09 09 WHERE id=?;" ...
5350: 20 20 20 73 74 61 74 65 20 0a 09 09 20 20 20 74 state ... t
5360: 61 73 6b 2d 69 64 29 29 0a 0a 3b 3b 3d 3d 3d 3d ask-id))..;;====
5370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5390: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
53a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
53b0: 3d 3d 0a 3b 3b 20 54 68 65 20 72 6f 75 74 69 6e ==.;; The routin
53c0: 65 73 20 74 6f 20 70 72 6f 63 65 73 73 20 74 61 es to process ta
53d0: 73 6b 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d sks.;;==========
53e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
53f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5400: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5410: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b ============..;;
5420: 20 4e 4f 54 45 3a 20 49 74 20 6d 69 67 68 74 20 NOTE: It might
5430: 62 65 20 67 6f 6f 64 20 74 6f 20 61 64 64 20 6f be good to add o
5440: 6e 65 20 6d 6f 72 65 20 6c 61 79 65 72 20 6f 66 ne more layer of
5450: 20 63 68 65 63 6b 69 6e 67 20 74 6f 20 65 6e 73 checking to ens
5460: 75 72 65 0a 3b 3b 20 20 20 20 20 20 20 74 68 61 ure.;; tha
5470: 74 20 6e 6f 20 74 61 73 6b 20 67 65 74 73 20 72 t no task gets r
5480: 75 6e 20 69 6e 20 70 61 72 61 6c 6c 65 6c 2e 0a un in parallel..
5490: 0a 28 64 65 66 69 6e 65 20 28 74 61 73 6b 73 3a .(define (tasks:
54a0: 73 74 61 72 74 2d 72 75 6e 20 64 62 20 6d 64 62 start-run db mdb
54b0: 20 74 61 73 6b 29 0a 20 20 28 6c 65 74 20 28 28 task). (let ((
54c0: 66 6c 61 67 73 20 28 6d 61 6b 65 2d 68 61 73 68 flags (make-hash
54d0: 2d 74 61 62 6c 65 29 29 29 0a 20 20 20 20 28 68 -table))). (h
54e0: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 66 ash-table-set! f
54f0: 6c 61 67 73 20 22 2d 72 65 72 75 6e 22 20 22 4e lags "-rerun" "N
5500: 4f 54 5f 53 54 41 52 54 45 44 22 29 0a 20 20 20 OT_STARTED").
5510: 20 28 69 66 20 28 6e 6f 74 20 28 73 74 72 69 6e (if (not (strin
5520: 67 3d 3f 20 28 74 61 73 6b 73 3a 74 61 73 6b 2d g=? (tasks:task-
5530: 67 65 74 2d 70 61 72 61 6d 73 20 74 61 73 6b 29 get-params task)
5540: 20 22 22 29 29 0a 09 28 68 61 73 68 2d 74 61 62 ""))..(hash-tab
5550: 6c 65 2d 73 65 74 21 20 66 6c 61 67 73 20 22 2d le-set! flags "-
5560: 73 65 74 76 61 72 73 22 20 28 74 61 73 6b 73 3a setvars" (tasks:
5570: 74 61 73 6b 2d 67 65 74 2d 70 61 72 61 6d 73 20 task-get-params
5580: 74 61 73 6b 29 29 29 0a 20 20 20 20 28 70 72 69 task))). (pri
5590: 6e 74 20 22 53 74 61 72 74 69 6e 67 20 72 75 6e nt "Starting run
55a0: 20 22 20 74 61 73 6b 29 0a 20 20 20 20 3b 3b 20 " task). ;;
55b0: 73 69 6c 6c 79 6e 65 73 73 2c 20 6a 75 73 74 20 sillyness, just
55c0: 63 61 6c 6c 20 74 68 65 20 64 61 6d 6e 20 72 6f call the damn ro
55d0: 75 74 69 6e 65 20 77 69 74 68 20 74 68 65 20 74 utine with the t
55e0: 61 73 6b 20 76 65 63 74 6f 72 20 61 6e 64 20 62 ask vector and b
55f0: 65 20 64 6f 6e 65 20 77 69 74 68 20 69 74 2e 20 e done with it.
5600: 46 49 58 4d 45 20 53 4f 4d 45 44 41 59 0a 20 20 FIXME SOMEDAY.
5610: 20 20 28 72 75 6e 73 3a 72 75 6e 2d 74 65 73 74 (runs:run-test
5620: 73 20 64 62 0a 09 09 20 20 20 20 28 74 61 73 6b s db... (task
5630: 73 3a 74 61 73 6b 2d 67 65 74 2d 74 61 72 67 65 s:task-get-targe
5640: 74 20 74 61 73 6b 29 0a 09 09 20 20 20 20 28 74 t task)... (t
5650: 61 73 6b 73 3a 74 61 73 6b 2d 67 65 74 2d 6e 61 asks:task-get-na
5660: 6d 65 20 20 20 74 61 73 6b 29 0a 09 09 20 20 20 me task)...
5670: 20 28 74 61 73 6b 73 3a 74 61 73 6b 2d 67 65 74 (tasks:task-get
5680: 2d 74 65 73 74 20 20 20 74 61 73 6b 29 0a 09 09 -test task)...
5690: 20 20 20 20 28 74 61 73 6b 73 3a 74 61 73 6b 2d (tasks:task-
56a0: 67 65 74 2d 69 74 65 6d 20 20 20 74 61 73 6b 29 get-item task)
56b0: 0a 09 09 20 20 20 20 28 74 61 73 6b 73 3a 74 61 ... (tasks:ta
56c0: 73 6b 2d 67 65 74 2d 6f 77 6e 65 72 20 20 74 61 sk-get-owner ta
56d0: 73 6b 29 0a 09 09 20 20 20 20 66 6c 61 67 73 29 sk)... flags)
56e0: 0a 20 20 20 20 28 74 61 73 6b 73 3a 73 65 74 2d . (tasks:set-
56f0: 73 74 61 74 65 20 6d 64 62 20 28 74 61 73 6b 73 state mdb (tasks
5700: 3a 74 61 73 6b 2d 67 65 74 2d 69 64 20 74 61 73 :task-get-id tas
5710: 6b 29 20 22 77 61 69 74 69 6e 67 22 29 29 29 0a k) "waiting"))).
5720: 0a 28 64 65 66 69 6e 65 20 28 74 61 73 6b 73 3a .(define (tasks:
5730: 72 6f 6c 6c 75 70 2d 72 75 6e 73 20 64 62 20 6d rollup-runs db m
5740: 64 62 20 74 61 73 6b 29 0a 20 20 28 6c 65 74 2a db task). (let*
5750: 20 28 28 66 6c 61 67 73 20 28 6d 61 6b 65 2d 68 ((flags (make-h
5760: 61 73 68 2d 74 61 62 6c 65 29 29 20 0a 09 20 28 ash-table)) .. (
5770: 6b 65 79 73 20 20 28 64 62 3a 67 65 74 2d 6b 65 keys (db:get-ke
5780: 79 73 20 64 62 29 29 0a 09 20 28 6b 65 79 76 61 ys db)).. (keyva
5790: 6c 73 20 28 6b 65 79 73 3a 74 61 72 67 65 74 2d ls (keys:target-
57a0: 6b 65 79 76 61 6c 20 6b 65 79 73 20 28 74 61 73 keyval keys (tas
57b0: 6b 73 3a 74 61 73 6b 2d 67 65 74 2d 74 61 72 67 ks:task-get-targ
57c0: 65 74 20 74 61 73 6b 29 29 29 29 0a 20 20 20 20 et task)))).
57d0: 3b 3b 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 ;; (hash-table-s
57e0: 65 74 21 20 66 6c 61 67 73 20 22 2d 72 65 72 75 et! flags "-reru
57f0: 6e 22 20 22 4e 4f 54 5f 53 54 41 52 54 45 44 22 n" "NOT_STARTED"
5800: 29 0a 20 20 20 20 28 70 72 69 6e 74 20 22 53 74 ). (print "St
5810: 61 72 74 69 6e 67 20 72 6f 6c 6c 75 70 20 22 20 arting rollup "
5820: 74 61 73 6b 29 0a 20 20 20 20 3b 3b 20 73 69 6c task). ;; sil
5830: 6c 79 6e 65 73 73 2c 20 6a 75 73 74 20 63 61 6c lyness, just cal
5840: 6c 20 74 68 65 20 64 61 6d 6e 20 72 6f 75 74 69 l the damn routi
5850: 6e 65 20 77 69 74 68 20 74 68 65 20 74 61 73 6b ne with the task
5860: 20 76 65 63 74 6f 72 20 61 6e 64 20 62 65 20 64 vector and be d
5870: 6f 6e 65 20 77 69 74 68 20 69 74 2e 20 46 49 58 one with it. FIX
5880: 4d 45 20 53 4f 4d 45 44 41 59 0a 20 20 20 20 28 ME SOMEDAY. (
5890: 72 75 6e 73 3a 72 6f 6c 6c 75 70 2d 72 75 6e 20 runs:rollup-run
58a0: 64 62 0a 09 09 20 20 20 20 20 6b 65 79 73 20 0a db... keys .
58b0: 09 09 20 20 20 20 20 6b 65 79 76 61 6c 73 0a 09 .. keyvals..
58c0: 09 20 20 20 20 20 28 74 61 73 6b 73 3a 74 61 73 . (tasks:tas
58d0: 6b 2d 67 65 74 2d 6e 61 6d 65 20 20 74 61 73 6b k-get-name task
58e0: 29 0a 09 09 20 20 20 20 20 28 74 61 73 6b 73 3a )... (tasks:
58f0: 74 61 73 6b 2d 67 65 74 2d 6f 77 6e 65 72 20 20 task-get-owner
5900: 74 61 73 6b 29 29 0a 20 20 20 20 28 74 61 73 6b task)). (task
5910: 73 3a 73 65 74 2d 73 74 61 74 65 20 6d 64 62 20 s:set-state mdb
5920: 28 74 61 73 6b 73 3a 74 61 73 6b 2d 67 65 74 2d (tasks:task-get-
5930: 69 64 20 74 61 73 6b 29 20 22 77 61 69 74 69 6e id task) "waitin
5940: 67 22 29 29 29 0a g"))).