0000: 3b 3b 20 43 6f 70 79 72 69 67 68 74 20 32 30 30 ;; Copyright 200
0010: 36 2d 32 30 31 32 2c 20 4d 61 74 74 68 65 77 20 6-2012, Matthew
0020: 57 65 6c 6c 61 6e 64 2e 0a 3b 3b 20 0a 3b 3b 20 Welland..;; .;;
0030: 20 54 68 69 73 20 70 72 6f 67 72 61 6d 20 69 73 This program is
0040: 20 6d 61 64 65 20 61 76 61 69 6c 61 62 6c 65 20 made available
0050: 75 6e 64 65 72 20 74 68 65 20 47 4e 55 20 47 50 under the GNU GP
0060: 4c 20 76 65 72 73 69 6f 6e 20 32 2e 30 20 6f 72 L version 2.0 or
0070: 0a 3b 3b 20 20 67 72 65 61 74 65 72 2e 20 53 65 .;; greater. Se
0080: 65 20 74 68 65 20 61 63 63 6f 6d 70 61 6e 79 69 e the accompanyi
0090: 6e 67 20 66 69 6c 65 20 43 4f 50 59 49 4e 47 20 ng file COPYING
00a0: 66 6f 72 20 64 65 74 61 69 6c 73 2e 0a 3b 3b 20 for details..;;
00b0: 0a 3b 3b 20 20 54 68 69 73 20 70 72 6f 67 72 61 .;; This progra
00c0: 6d 20 69 73 20 64 69 73 74 72 69 62 75 74 65 64 m is distributed
00d0: 20 57 49 54 48 4f 55 54 20 41 4e 59 20 57 41 52 WITHOUT ANY WAR
00e0: 52 41 4e 54 59 3b 20 77 69 74 68 6f 75 74 20 65 RANTY; without e
00f0: 76 65 6e 20 74 68 65 0a 3b 3b 20 20 69 6d 70 6c ven the.;; impl
0100: 69 65 64 20 77 61 72 72 61 6e 74 79 20 6f 66 20 ied warranty of
0110: 4d 45 52 43 48 41 4e 54 41 42 49 4c 49 54 59 20 MERCHANTABILITY
0120: 6f 72 20 46 49 54 4e 45 53 53 20 46 4f 52 20 41 or FITNESS FOR A
0130: 20 50 41 52 54 49 43 55 4c 41 52 0a 3b 3b 20 20 PARTICULAR.;;
0140: 50 55 52 50 4f 53 45 2e 0a 0a 3b 3b 20 20 73 74 PURPOSE...;; st
0150: 72 66 74 69 6d 65 28 27 25 6d 2f 25 64 2f 25 59 rftime('%m/%d/%Y
0160: 20 25 48 3a 25 4d 3a 25 53 27 2c 27 6e 6f 77 27 %H:%M:%S','now'
0170: 2c 27 6c 6f 63 61 6c 74 69 6d 65 27 29 0a 0a 28 ,'localtime')..(
0180: 75 73 65 20 73 71 6c 69 74 65 33 20 73 72 66 69 use sqlite3 srfi
0190: 2d 31 20 70 6f 73 69 78 20 72 65 67 65 78 20 72 -1 posix regex r
01a0: 65 67 65 78 2d 63 61 73 65 20 73 72 66 69 2d 36 egex-case srfi-6
01b0: 39 20 64 6f 74 2d 6c 6f 63 6b 69 6e 67 20 66 6f 9 dot-locking fo
01c0: 72 6d 61 74 29 0a 28 69 6d 70 6f 72 74 20 28 70 rmat).(import (p
01d0: 72 65 66 69 78 20 73 71 6c 69 74 65 33 20 73 71 refix sqlite3 sq
01e0: 6c 69 74 65 33 3a 29 29 0a 0a 28 64 65 63 6c 61 lite3:))..(decla
01f0: 72 65 20 28 75 6e 69 74 20 74 61 73 6b 73 29 29 re (unit tasks))
0200: 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 .(declare (uses
0210: 64 62 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 db)).(declare (u
0220: 73 65 73 20 63 6f 6d 6d 6f 6e 29 29 0a 0a 28 69 ses common))..(i
0230: 6e 63 6c 75 64 65 20 22 74 61 73 6b 5f 72 65 63 nclude "task_rec
0240: 6f 72 64 73 2e 73 63 6d 22 29 0a 0a 3b 3b 3d 3d ords.scm")..;;==
0250: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0260: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0270: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0280: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0290: 3d 3d 3d 3d 0a 3b 3b 20 54 61 73 6b 73 20 64 62 ====.;; Tasks db
02a0: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
02b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
02c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
02d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
02e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 =========..(defi
02f0: 6e 65 20 28 74 61 73 6b 73 3a 6f 70 65 6e 2d 64 ne (tasks:open-d
0300: 62 29 0a 20 20 28 6c 65 74 2a 20 28 28 64 62 70 b). (let* ((dbp
0310: 61 74 68 20 20 28 63 6f 6e 63 20 2a 74 6f 70 70 ath (conc *topp
0320: 61 74 68 2a 20 22 2f 6d 6f 6e 69 74 6f 72 2e 64 ath* "/monitor.d
0330: 62 22 29 29 0a 09 20 28 65 78 69 73 74 73 20 20 b")).. (exists
0340: 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 64 62 (file-exists? db
0350: 70 61 74 68 29 29 0a 09 20 28 74 64 62 20 20 20 path)).. (tdb
0360: 20 20 28 73 71 6c 69 74 65 33 3a 6f 70 65 6e 2d (sqlite3:open-
0370: 64 61 74 61 62 61 73 65 20 64 62 70 61 74 68 29 database dbpath)
0380: 29 20 3b 3b 20 28 6e 65 76 65 72 2d 67 69 76 65 ) ;; (never-give
0390: 2d 75 70 2d 6f 70 65 6e 2d 64 62 20 64 62 70 61 -up-open-db dbpa
03a0: 74 68 29 29 0a 09 20 28 68 61 6e 64 6c 65 72 20 th)).. (handler
03b0: 28 6d 61 6b 65 2d 62 75 73 79 2d 74 69 6d 65 6f (make-busy-timeo
03c0: 75 74 20 33 36 30 30 30 29 29 29 0a 20 20 20 20 ut 36000))).
03d0: 28 73 71 6c 69 74 65 33 3a 73 65 74 2d 62 75 73 (sqlite3:set-bus
03e0: 79 2d 68 61 6e 64 6c 65 72 21 20 74 64 62 20 68 y-handler! tdb h
03f0: 61 6e 64 6c 65 72 29 0a 20 20 20 20 28 69 66 20 andler). (if
0400: 28 6e 6f 74 20 65 78 69 73 74 73 29 0a 09 28 62 (not exists)..(b
0410: 65 67 69 6e 0a 09 20 20 28 73 71 6c 69 74 65 33 egin.. (sqlite3
0420: 3a 65 78 65 63 75 74 65 20 74 64 62 20 22 43 52 :execute tdb "CR
0430: 45 41 54 45 20 54 41 42 4c 45 20 49 46 20 4e 4f EATE TABLE IF NO
0440: 54 20 45 58 49 53 54 53 20 74 61 73 6b 73 5f 71 T EXISTS tasks_q
0450: 75 65 75 65 20 28 69 64 20 49 4e 54 45 47 45 52 ueue (id INTEGER
0460: 20 50 52 49 4d 41 52 59 20 4b 45 59 2c 0a 20 20 PRIMARY KEY,.
0470: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0480: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 61 63 ac
0490: 74 69 6f 6e 20 54 45 58 54 20 44 45 46 41 55 4c tion TEXT DEFAUL
04a0: 54 20 27 27 2c 0a 20 20 20 20 20 20 20 20 20 20 T '',.
04b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
04c0: 20 20 20 20 20 20 6f 77 6e 65 72 20 54 45 58 54 owner TEXT
04d0: 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ,.
04e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
04f0: 20 20 73 74 61 74 65 20 54 45 58 54 20 44 45 46 state TEXT DEF
0500: 41 55 4c 54 20 27 6e 65 77 27 2c 0a 20 20 20 20 AULT 'new',.
0510: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0520: 20 20 20 20 20 20 20 20 20 20 20 20 74 61 72 67 targ
0530: 65 74 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 et TEXT DEFAULT
0540: 27 27 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 '',.
0550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0560: 20 20 20 20 6e 61 6d 65 20 54 45 58 54 20 44 45 name TEXT DE
0570: 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 FAULT '',.
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 20 74 65 73 74 20 54 test T
05a0: 45 58 54 20 44 45 46 41 55 4c 54 20 27 27 2c 0a EXT DEFAULT '',.
05b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
05c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
05d0: 69 74 65 6d 20 54 45 58 54 20 44 45 46 41 55 4c item TEXT DEFAUL
05e0: 54 20 27 27 2c 0a 20 20 20 20 20 20 20 20 20 20 T '',.
05f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0600: 20 20 20 20 20 20 6b 65 79 6c 6f 63 6b 20 54 45 keylock TE
0610: 58 54 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 XT,.
0620: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0630: 20 20 20 20 70 61 72 61 6d 73 20 54 45 58 54 2c params TEXT,
0640: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
0650: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0660: 20 63 72 65 61 74 69 6f 6e 5f 74 69 6d 65 20 54 creation_time T
0670: 49 4d 45 53 54 41 4d 50 2c 0a 20 20 20 20 20 20 IMESTAMP,.
0680: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0690: 20 20 20 20 20 20 20 20 20 20 65 78 65 63 75 74 execut
06a0: 69 6f 6e 5f 74 69 6d 65 20 54 49 4d 45 53 54 41 ion_time TIMESTA
06b0: 4d 50 29 3b 22 29 0a 09 20 20 28 73 71 6c 69 74 MP);").. (sqlit
06c0: 65 33 3a 65 78 65 63 75 74 65 20 74 64 62 20 22 e3:execute tdb "
06d0: 43 52 45 41 54 45 20 54 41 42 4c 45 20 49 46 20 CREATE TABLE IF
06e0: 4e 4f 54 20 45 58 49 53 54 53 20 6d 6f 6e 69 74 NOT EXISTS monit
06f0: 6f 72 73 20 28 69 64 20 49 4e 54 45 47 45 52 20 ors (id INTEGER
0700: 50 52 49 4d 41 52 59 20 4b 45 59 2c 0a 20 20 20 PRIMARY KEY,.
0710: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0720: 20 20 20 20 20 20 20 20 20 20 20 20 20 70 69 64 pid
0730: 20 49 4e 54 45 47 45 52 2c 0a 20 20 20 20 20 20 INTEGER,.
0740: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0750: 20 20 20 20 20 20 20 20 20 20 73 74 61 72 74 5f start_
0760: 74 69 6d 65 20 54 49 4d 45 53 54 41 4d 50 2c 0a time TIMESTAMP,.
0770: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0780: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0790: 6c 61 73 74 5f 75 70 64 61 74 65 20 54 49 4d 45 last_update TIME
07a0: 53 54 41 4d 50 2c 0a 20 20 20 20 20 20 20 20 20 STAMP,.
07b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
07c0: 20 20 20 20 20 20 20 68 6f 73 74 6e 61 6d 65 20 hostname
07d0: 54 45 58 54 2c 0a 20 20 20 20 20 20 20 20 20 20 TEXT,.
07e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
07f0: 20 20 20 20 20 20 75 73 65 72 6e 61 6d 65 20 54 username T
0800: 45 58 54 2c 0a 20 20 20 20 20 20 20 20 20 20 20 EXT,.
0810: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0820: 20 20 20 20 43 4f 4e 53 54 52 41 49 4e 54 20 6d CONSTRAINT m
0830: 6f 6e 69 74 6f 72 73 5f 63 6f 6e 73 74 72 61 69 onitors_constrai
0840: 6e 74 20 55 4e 49 51 55 45 20 28 70 69 64 2c 68 nt UNIQUE (pid,h
0850: 6f 73 74 6e 61 6d 65 29 29 3b 22 29 29 29 0a 20 ostname));"))).
0860: 20 20 20 74 64 62 29 29 0a 20 20 20 20 0a 0a 3b tdb)). ..;
0870: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
0880: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0890: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
08a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
08b0: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 54 61 73 6b 73 =======.;; Tasks
08c0: 20 61 6e 64 20 54 61 73 6b 20 6d 6f 6e 69 74 6f and Task monito
08d0: 72 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d rs.;;===========
08e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
08f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0900: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0910: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 0a 3b 3b ===========...;;
0920: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0930: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0940: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0950: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0960: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 54 61 73 6b 73 0a ======.;; Tasks.
0970: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
0980: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0990: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
09a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
09b0: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 0a 0a 3b 3b 3d 3d ========....;;==
09c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
09d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
09e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
09f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0a00: 3d 3d 3d 3d 0a 3b 3b 20 54 61 73 6b 20 4d 6f 6e ====.;; Task Mon
0a10: 69 74 6f 72 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d itors.;;========
0a20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0a30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0a40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0a50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
0a60: 28 64 65 66 69 6e 65 20 28 74 61 73 6b 73 3a 72 (define (tasks:r
0a70: 65 67 69 73 74 65 72 2d 6d 6f 6e 69 74 6f 72 20 egister-monitor
0a80: 64 62 20 74 64 62 29 0a 20 20 28 6c 65 74 2a 20 db tdb). (let*
0a90: 28 28 70 69 64 20 28 63 75 72 72 65 6e 74 2d 70 ((pid (current-p
0aa0: 72 6f 63 65 73 73 2d 69 64 29 29 0a 09 20 28 68 rocess-id)).. (h
0ab0: 6f 73 74 6e 61 6d 65 20 28 67 65 74 2d 68 6f 73 ostname (get-hos
0ac0: 74 2d 6e 61 6d 65 29 29 0a 09 20 28 75 73 65 72 t-name)).. (user
0ad0: 69 6e 66 6f 20 28 75 73 65 72 2d 69 6e 66 6f 72 info (user-infor
0ae0: 6d 61 74 69 6f 6e 20 28 63 75 72 72 65 6e 74 2d mation (current-
0af0: 75 73 65 72 2d 69 64 29 29 29 0a 09 20 28 75 73 user-id))).. (us
0b00: 65 72 6e 61 6d 65 20 28 63 61 72 20 75 73 65 72 ername (car user
0b10: 69 6e 66 6f 29 29 29 0a 20 20 20 20 28 70 72 69 info))). (pri
0b20: 6e 74 20 22 52 65 67 69 73 74 65 72 20 6d 6f 6e nt "Register mon
0b30: 69 74 6f 72 2c 20 70 69 64 3a 20 22 20 70 69 64 itor, pid: " pid
0b40: 20 22 2c 20 68 6f 73 74 6e 61 6d 65 3a 20 22 20 ", hostname: "
0b50: 68 6f 73 74 6e 61 6d 65 20 22 2c 20 75 73 65 72 hostname ", user
0b60: 6e 61 6d 65 3a 20 22 20 75 73 65 72 6e 61 6d 65 name: " username
0b70: 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 ). (sqlite3:e
0b80: 78 65 63 75 74 65 20 74 64 62 20 22 49 4e 53 45 xecute tdb "INSE
0b90: 52 54 20 49 4e 54 4f 20 6d 6f 6e 69 74 6f 72 73 RT INTO monitors
0ba0: 20 28 70 69 64 2c 73 74 61 72 74 5f 74 69 6d 65 (pid,start_time
0bb0: 2c 6c 61 73 74 5f 75 70 64 61 74 65 2c 68 6f 73 ,last_update,hos
0bc0: 74 6e 61 6d 65 2c 75 73 65 72 6e 61 6d 65 29 20 tname,username)
0bd0: 56 41 4c 55 45 53 20 28 3f 2c 73 74 72 66 74 69 VALUES (?,strfti
0be0: 6d 65 28 27 25 73 27 2c 27 6e 6f 77 27 29 2c 73 me('%s','now'),s
0bf0: 74 72 66 74 69 6d 65 28 27 25 73 27 2c 27 6e 6f trftime('%s','no
0c00: 77 27 29 2c 3f 2c 3f 29 3b 22 0a 09 09 20 20 20 w'),?,?);"...
0c10: 20 20 70 69 64 20 68 6f 73 74 6e 61 6d 65 20 75 pid hostname u
0c20: 73 65 72 6e 61 6d 65 29 29 29 0a 0a 28 64 65 66 sername)))..(def
0c30: 69 6e 65 20 28 74 61 73 6b 73 3a 67 65 74 2d 6e ine (tasks:get-n
0c40: 75 6d 2d 61 6c 69 76 65 2d 6d 6f 6e 69 74 6f 72 um-alive-monitor
0c50: 73 20 74 64 62 29 0a 20 20 28 6c 65 74 20 28 28 s tdb). (let ((
0c60: 72 65 73 20 30 29 29 0a 20 20 20 20 28 73 71 6c res 0)). (sql
0c70: 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f ite3:for-each-ro
0c80: 77 20 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 w . (lambda
0c90: 28 63 6f 75 6e 74 29 0a 20 20 20 20 20 20 20 28 (count). (
0ca0: 73 65 74 21 20 72 65 73 20 63 6f 75 6e 74 29 29 set! res count))
0cb0: 0a 20 20 20 20 20 74 64 62 0a 20 20 20 20 20 22 . tdb. "
0cc0: 53 45 4c 45 43 54 20 63 6f 75 6e 74 28 69 64 29 SELECT count(id)
0cd0: 20 46 52 4f 4d 20 6d 6f 6e 69 74 6f 72 73 20 57 FROM monitors W
0ce0: 48 45 52 45 20 6c 61 73 74 5f 75 70 64 61 74 65 HERE last_update
0cf0: 20 3c 20 28 73 74 72 66 74 69 6d 65 28 27 25 73 < (strftime('%s
0d00: 27 2c 27 6e 6f 77 27 29 20 2d 20 33 30 30 29 20 ','now') - 300)
0d10: 41 4e 44 20 75 73 65 72 6e 61 6d 65 3d 3f 3b 22 AND username=?;"
0d20: 0a 20 20 20 20 20 28 63 61 72 20 28 75 73 65 72 . (car (user
0d30: 2d 69 6e 66 6f 72 6d 61 74 69 6f 6e 20 28 63 75 -information (cu
0d40: 72 72 65 6e 74 2d 75 73 65 72 2d 69 64 29 29 29 rrent-user-id)))
0d50: 29 0a 20 20 20 20 72 65 73 29 29 0a 0a 3b 3b 20 ). res))..;;
0d60: 72 65 67 69 73 74 65 72 20 61 20 74 61 73 6b 0a register a task.
0d70: 28 64 65 66 69 6e 65 20 28 74 61 73 6b 73 3a 61 (define (tasks:a
0d80: 64 64 20 74 64 62 20 61 63 74 69 6f 6e 20 6f 77 dd tdb action ow
0d90: 6e 65 72 20 74 61 72 67 65 74 20 72 75 6e 6e 61 ner target runna
0da0: 6d 65 20 74 65 73 74 20 69 74 65 6d 20 70 61 72 me test item par
0db0: 61 6d 73 29 0a 20 20 28 73 71 6c 69 74 65 33 3a ams). (sqlite3:
0dc0: 65 78 65 63 75 74 65 20 74 64 62 20 22 49 4e 53 execute tdb "INS
0dd0: 45 52 54 20 49 4e 54 4f 20 74 61 73 6b 73 5f 71 ERT INTO tasks_q
0de0: 75 65 75 65 20 28 61 63 74 69 6f 6e 2c 6f 77 6e ueue (action,own
0df0: 65 72 2c 73 74 61 74 65 2c 74 61 72 67 65 74 2c er,state,target,
0e00: 6e 61 6d 65 2c 74 65 73 74 2c 69 74 65 6d 2c 70 name,test,item,p
0e10: 61 72 61 6d 73 2c 63 72 65 61 74 69 6f 6e 5f 74 arams,creation_t
0e20: 69 6d 65 2c 65 78 65 63 75 74 69 6f 6e 5f 74 69 ime,execution_ti
0e30: 6d 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 me).
0e40: 20 20 20 20 20 20 20 20 20 20 20 56 41 4c 55 45 VALUE
0e50: 53 20 28 3f 2c 3f 2c 27 6e 65 77 27 2c 3f 2c 3f S (?,?,'new',?,?
0e60: 2c 3f 2c 3f 2c 3f 2c 73 74 72 66 74 69 6d 65 28 ,?,?,?,strftime(
0e70: 27 25 73 27 2c 27 6e 6f 77 27 29 2c 30 29 3b 22 '%s','now'),0);"
0e80: 20 0a 09 09 20 20 20 61 63 74 69 6f 6e 0a 09 09 ... action...
0e90: 20 20 20 6f 77 6e 65 72 0a 09 09 20 20 20 74 61 owner... ta
0ea0: 72 67 65 74 0a 09 09 20 20 20 72 75 6e 6e 61 6d rget... runnam
0eb0: 65 0a 09 09 20 20 20 74 65 73 74 0a 09 09 20 20 e... test...
0ec0: 20 69 74 65 6d 0a 09 09 20 20 20 28 69 66 20 70 item... (if p
0ed0: 61 72 61 6d 73 20 70 61 72 61 6d 73 20 22 22 29 arams params "")
0ee0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 6b 65 79 ))..(define (key
0ef0: 73 3a 6b 65 79 2d 76 61 6c 73 2d 68 61 73 68 2d s:key-vals-hash-
0f00: 3e 74 61 72 67 65 74 20 6b 65 79 73 20 6b 65 79 >target keys key
0f10: 2d 70 61 72 61 6d 73 29 0a 20 20 28 6c 65 74 20 -params). (let
0f20: 28 28 74 6d 70 20 28 68 61 73 68 2d 74 61 62 6c ((tmp (hash-tabl
0f30: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 6b 65 e-ref/default ke
0f40: 79 2d 70 61 72 61 6d 73 20 28 76 65 63 74 6f 72 y-params (vector
0f50: 2d 72 65 66 20 28 63 61 72 20 6b 65 79 73 29 20 -ref (car keys)
0f60: 30 29 20 22 22 29 29 29 0a 20 20 20 20 28 69 66 0) ""))). (if
0f70: 20 28 3e 20 28 6c 65 6e 67 74 68 20 6b 65 79 73 (> (length keys
0f80: 29 20 31 29 0a 09 28 66 6f 72 2d 65 61 63 68 20 ) 1)..(for-each
0f90: 28 6c 61 6d 62 64 61 20 28 6b 65 79 29 0a 09 09 (lambda (key)...
0fa0: 20 20 20 20 28 73 65 74 21 20 74 6d 70 20 28 63 (set! tmp (c
0fb0: 6f 6e 63 20 74 6d 70 20 22 2f 22 20 28 68 61 73 onc tmp "/" (has
0fc0: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
0fd0: 75 6c 74 20 6b 65 79 2d 70 61 72 61 6d 73 20 28 ult key-params (
0fe0: 76 65 63 74 6f 72 2d 72 65 66 20 6b 65 79 20 30 vector-ref key 0
0ff0: 29 20 22 22 29 29 29 29 0a 09 09 20 20 28 63 64 ) ""))))... (cd
1000: 72 20 6b 65 79 73 29 29 29 0a 20 20 20 20 74 6d r keys))). tm
1010: 70 29 29 0a 09 09 09 09 09 09 09 09 0a 3b 3b 20 p))..........;;
1020: 66 6f 72 20 75 73 65 20 66 72 6f 6d 20 74 68 65 for use from the
1030: 20 67 75 69 0a 28 64 65 66 69 6e 65 20 28 74 61 gui.(define (ta
1040: 73 6b 73 3a 61 64 64 2d 66 72 6f 6d 2d 70 61 72 sks:add-from-par
1050: 61 6d 73 20 74 64 62 20 61 63 74 69 6f 6e 20 6b ams tdb action k
1060: 65 79 73 20 6b 65 79 2d 70 61 72 61 6d 73 20 76 eys key-params v
1070: 61 72 2d 70 61 72 61 6d 73 29 0a 20 20 28 6c 65 ar-params). (le
1080: 74 20 28 28 74 61 72 67 65 74 20 20 20 20 28 6b t ((target (k
1090: 65 79 73 3a 6b 65 79 2d 76 61 6c 73 2d 68 61 73 eys:key-vals-has
10a0: 68 2d 3e 74 61 72 67 65 74 20 6b 65 79 73 20 6b h->target keys k
10b0: 65 79 2d 70 61 72 61 6d 73 29 29 0a 09 28 6f 77 ey-params))..(ow
10c0: 6e 65 72 20 20 20 20 20 28 63 61 72 20 28 75 73 ner (car (us
10d0: 65 72 2d 69 6e 66 6f 72 6d 61 74 69 6f 6e 20 28 er-information (
10e0: 63 75 72 72 65 6e 74 2d 75 73 65 72 2d 69 64 29 current-user-id)
10f0: 29 29 29 0a 09 28 72 75 6e 6e 61 6d 65 20 20 20 )))..(runname
1100: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
1110: 64 65 66 61 75 6c 74 20 76 61 72 2d 70 61 72 61 default var-para
1120: 6d 73 20 22 72 75 6e 6e 61 6d 65 22 20 23 66 29 ms "runname" #f)
1130: 29 0a 09 28 74 65 73 74 70 61 74 74 73 20 28 68 )..(testpatts (h
1140: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
1150: 66 61 75 6c 74 20 76 61 72 2d 70 61 72 61 6d 73 fault var-params
1160: 20 22 74 65 73 74 70 61 74 74 73 22 20 22 25 22 "testpatts" "%"
1170: 29 29 0a 09 28 69 74 65 6d 70 61 74 74 73 20 28 ))..(itempatts (
1180: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
1190: 65 66 61 75 6c 74 20 76 61 72 2d 70 61 72 61 6d efault var-param
11a0: 73 20 22 69 74 65 6d 70 61 74 74 73 22 20 22 25 s "itempatts" "%
11b0: 22 29 29 0a 09 28 70 61 72 61 6d 73 20 20 20 20 "))..(params
11c0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
11d0: 64 65 66 61 75 6c 74 20 76 61 72 2d 70 61 72 61 default var-para
11e0: 6d 73 20 22 70 61 72 61 6d 73 22 20 20 20 20 22 ms "params" "
11f0: 22 29 29 29 0a 20 20 20 20 28 74 61 73 6b 73 3a "))). (tasks:
1200: 61 64 64 20 74 64 62 20 61 63 74 69 6f 6e 20 6f add tdb action o
1210: 77 6e 65 72 20 74 61 72 67 65 74 20 72 75 6e 6e wner target runn
1220: 61 6d 65 20 74 65 73 74 70 61 74 74 73 20 69 74 ame testpatts it
1230: 65 6d 70 61 74 74 73 20 70 61 72 61 6d 73 29 29 empatts params))
1240: 29 0a 0a 3b 3b 20 72 65 74 75 72 6e 20 6f 6e 65 )..;; return one
1250: 20 74 61 73 6b 20 66 72 6f 6d 20 74 68 6f 73 65 task from those
1260: 20 77 68 6f 20 61 72 65 20 27 6e 65 77 27 20 4f who are 'new' O
1270: 52 20 27 77 61 69 74 69 6e 67 27 20 41 4e 44 20 R 'waiting' AND
1280: 6d 6f 72 65 20 74 68 61 6e 20 31 30 73 65 63 20 more than 10sec
1290: 6f 6c 64 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 old.;;.(define (
12a0: 74 61 73 6b 73 3a 73 6e 61 67 2d 61 2d 74 61 73 tasks:snag-a-tas
12b0: 6b 20 74 64 62 29 0a 20 20 28 6c 65 74 20 28 28 k tdb). (let ((
12c0: 72 65 73 20 20 20 20 23 66 29 0a 09 28 6b 65 79 res #f)..(key
12d0: 74 78 74 20 28 63 6f 6e 63 20 28 63 75 72 72 65 txt (conc (curre
12e0: 6e 74 2d 70 72 6f 63 65 73 73 2d 69 64 29 20 22 nt-process-id) "
12f0: 2d 22 20 28 67 65 74 2d 68 6f 73 74 2d 6e 61 6d -" (get-host-nam
1300: 65 29 20 22 2d 22 20 28 63 61 72 20 28 75 73 65 e) "-" (car (use
1310: 72 2d 69 6e 66 6f 72 6d 61 74 69 6f 6e 20 28 63 r-information (c
1320: 75 72 72 65 6e 74 2d 75 73 65 72 2d 69 64 29 29 urrent-user-id))
1330: 29 29 29 29 0a 0a 20 20 20 20 3b 3b 20 66 69 72 )))).. ;; fir
1340: 73 74 20 72 61 6e 64 6f 6d 6c 79 20 73 65 74 20 st randomly set
1350: 61 20 6e 65 77 20 74 6f 20 70 69 64 2d 68 6f 73 a new to pid-hos
1360: 74 6e 61 6d 65 2d 68 6f 73 74 6e 61 6d 65 0a 20 tname-hostname.
1370: 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 (sqlite3:exec
1380: 75 74 65 0a 20 20 20 20 20 74 64 62 20 0a 20 20 ute. tdb .
1390: 20 20 20 22 55 50 44 41 54 45 20 74 61 73 6b 73 "UPDATE tasks
13a0: 5f 71 75 65 75 65 20 53 45 54 20 6b 65 79 6c 6f _queue SET keylo
13b0: 63 6b 3d 3f 20 57 48 45 52 45 20 69 64 20 49 4e ck=? WHERE id IN
13c0: 0a 20 20 20 20 20 20 20 20 28 53 45 4c 45 43 54 . (SELECT
13d0: 20 69 64 20 46 52 4f 4d 20 74 61 73 6b 73 5f 71 id FROM tasks_q
13e0: 75 65 75 65 20 0a 20 20 20 20 20 20 20 20 20 20 ueue .
13f0: 20 57 48 45 52 45 20 73 74 61 74 65 3d 27 6e 65 WHERE state='ne
1400: 77 27 20 4f 52 20 0a 20 20 20 20 20 20 20 20 20 w' OR .
1410: 20 20 20 20 20 20 20 20 28 73 74 61 74 65 3d 27 (state='
1420: 77 61 69 74 69 6e 67 27 20 41 4e 44 20 28 73 74 waiting' AND (st
1430: 72 66 74 69 6d 65 28 27 25 73 27 2c 27 6e 6f 77 rftime('%s','now
1440: 27 29 2d 65 78 65 63 75 74 69 6f 6e 5f 74 69 6d ')-execution_tim
1450: 65 29 20 3e 20 31 30 29 20 4f 52 0a 20 20 20 20 e) > 10) OR.
1460: 20 20 20 20 20 20 20 20 20 20 20 20 20 73 74 61 sta
1470: 74 65 3d 27 72 65 73 65 74 27 0a 20 20 20 20 20 te='reset'.
1480: 20 20 20 20 20 20 4f 52 44 45 52 20 42 59 20 52 ORDER BY R
1490: 41 4e 44 4f 4d 28 29 20 4c 49 4d 49 54 20 31 29 ANDOM() LIMIT 1)
14a0: 3b 22 20 6b 65 79 74 78 74 29 0a 0a 20 20 20 20 ;" keytxt)..
14b0: 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 (sqlite3:for-eac
14c0: 68 2d 72 6f 77 0a 20 20 20 20 20 28 6c 61 6d 62 h-row. (lamb
14d0: 64 61 20 28 69 64 20 2e 20 72 65 6d 29 0a 20 20 da (id . rem).
14e0: 20 20 20 20 20 28 73 65 74 21 20 72 65 73 20 28 (set! res (
14f0: 61 70 70 6c 79 20 76 65 63 74 6f 72 20 69 64 20 apply vector id
1500: 72 65 6d 29 29 29 0a 20 20 20 20 20 74 64 62 0a rem))). tdb.
1510: 20 20 20 20 20 22 53 45 4c 45 43 54 20 69 64 2c "SELECT id,
1520: 61 63 74 69 6f 6e 2c 6f 77 6e 65 72 2c 73 74 61 action,owner,sta
1530: 74 65 2c 74 61 72 67 65 74 2c 6e 61 6d 65 2c 74 te,target,name,t
1540: 65 73 74 2c 69 74 65 6d 2c 70 61 72 61 6d 73 2c est,item,params,
1550: 63 72 65 61 74 69 6f 6e 5f 74 69 6d 65 2c 65 78 creation_time,ex
1560: 65 63 75 74 69 6f 6e 5f 74 69 6d 65 20 46 52 4f ecution_time FRO
1570: 4d 20 74 61 73 6b 73 5f 71 75 65 75 65 20 57 48 M tasks_queue WH
1580: 45 52 45 20 6b 65 79 6c 6f 63 6b 3d 3f 20 4f 52 ERE keylock=? OR
1590: 44 45 52 20 42 59 20 65 78 65 63 75 74 69 6f 6e DER BY execution
15a0: 5f 74 69 6d 65 20 41 53 43 20 4c 49 4d 49 54 20 _time ASC LIMIT
15b0: 31 3b 22 20 6b 65 79 74 78 74 29 0a 20 20 20 20 1;" keytxt).
15c0: 28 69 66 20 72 65 73 20 3b 3b 20 79 65 70 2c 20 (if res ;; yep,
15d0: 68 61 76 65 20 77 6f 72 6b 20 74 6f 20 62 65 20 have work to be
15e0: 64 6f 6e 65 0a 09 28 62 65 67 69 6e 0a 09 20 20 done..(begin..
15f0: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
1600: 20 74 64 62 20 22 55 50 44 41 54 45 20 74 61 73 tdb "UPDATE tas
1610: 6b 73 5f 71 75 65 75 65 20 53 45 54 20 73 74 61 ks_queue SET sta
1620: 74 65 3d 27 69 6e 70 72 6f 67 72 65 73 73 27 2c te='inprogress',
1630: 65 78 65 63 75 74 69 6f 6e 5f 74 69 6d 65 3d 73 execution_time=s
1640: 74 72 66 74 69 6d 65 28 27 25 73 27 2c 27 6e 6f trftime('%s','no
1650: 77 27 29 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 w') WHERE id=?;"
1660: 0a 09 09 09 20 20 20 28 74 61 73 6b 73 3a 74 61 .... (tasks:ta
1670: 73 6b 2d 67 65 74 2d 69 64 20 72 65 73 29 29 0a sk-get-id res)).
1680: 09 20 20 72 65 73 29 0a 09 23 66 29 29 29 0a 0a . res)..#f)))..
1690: 28 64 65 66 69 6e 65 20 28 74 61 73 6b 73 3a 72 (define (tasks:r
16a0: 65 73 65 74 2d 73 74 75 63 6b 2d 74 61 73 6b 73 eset-stuck-tasks
16b0: 20 74 64 62 29 0a 20 20 28 6c 65 74 20 28 28 72 tdb). (let ((r
16c0: 65 73 20 27 28 29 29 29 0a 20 20 20 20 28 73 71 es '())). (sq
16d0: 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 lite3:for-each-r
16e0: 6f 77 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 ow. (lambda
16f0: 28 69 64 20 64 65 6c 74 61 29 0a 20 20 20 20 20 (id delta).
1700: 20 20 28 73 65 74 21 20 72 65 73 20 28 63 6f 6e (set! res (con
1710: 73 20 69 64 20 72 65 73 29 29 29 0a 20 20 20 20 s id res))).
1720: 20 74 64 62 0a 20 20 20 20 20 22 53 45 4c 45 43 tdb. "SELEC
1730: 54 20 69 64 2c 73 74 72 66 74 69 6d 65 28 27 25 T id,strftime('%
1740: 73 27 2c 27 6e 6f 77 27 29 2d 65 78 65 63 75 74 s','now')-execut
1750: 69 6f 6e 5f 74 69 6d 65 20 41 53 20 64 65 6c 74 ion_time AS delt
1760: 61 20 46 52 4f 4d 20 74 61 73 6b 73 5f 71 75 65 a FROM tasks_que
1770: 75 65 20 57 48 45 52 45 20 73 74 61 74 65 3d 27 ue WHERE state='
1780: 69 6e 70 72 6f 67 72 65 73 73 27 20 41 4e 44 20 inprogress' AND
1790: 64 65 6c 74 61 3e 37 30 30 20 4f 52 44 45 52 20 delta>700 ORDER
17a0: 42 59 20 64 65 6c 74 61 20 44 45 53 43 20 4c 49 BY delta DESC LI
17b0: 4d 49 54 20 32 3b 22 29 0a 20 20 20 20 28 73 71 MIT 2;"). (sq
17c0: 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 0a 20 lite3:execute .
17d0: 20 20 20 20 74 64 62 20 0a 20 20 20 20 20 28 63 tdb . (c
17e0: 6f 6e 63 20 22 55 50 44 41 54 45 20 74 61 73 6b onc "UPDATE task
17f0: 73 5f 71 75 65 75 65 20 53 45 54 20 73 74 61 74 s_queue SET stat
1800: 65 3d 27 72 65 73 65 74 27 20 57 48 45 52 45 20 e='reset' WHERE
1810: 69 64 20 49 4e 20 28 27 22 20 28 73 74 72 69 6e id IN ('" (strin
1820: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 6d g-intersperse (m
1830: 61 70 20 63 6f 6e 63 20 72 65 73 29 20 22 27 2c ap conc res) "',
1840: 27 22 29 20 22 27 29 3b 22 29 29 29 29 0a 0a 3b '") "');"))))..;
1850: 3b 20 72 65 74 75 72 6e 20 61 6c 6c 20 74 61 73 ; return all tas
1860: 6b 73 20 69 6e 20 74 68 65 20 74 61 73 6b 73 5f ks in the tasks_
1870: 71 75 65 75 65 20 74 61 62 6c 65 0a 3b 3b 0a 28 queue table.;;.(
1880: 64 65 66 69 6e 65 20 28 74 61 73 6b 73 3a 67 65 define (tasks:ge
1890: 74 2d 74 61 73 6b 73 20 74 64 62 20 74 79 70 65 t-tasks tdb type
18a0: 73 20 73 74 61 74 65 73 29 0a 20 20 28 6c 65 74 s states). (let
18b0: 20 28 28 72 65 73 20 27 28 29 29 29 0a 20 20 20 ((res '())).
18c0: 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 (sqlite3:for-ea
18d0: 63 68 2d 72 6f 77 0a 20 20 20 20 20 28 6c 61 6d ch-row. (lam
18e0: 62 64 61 20 28 69 64 20 2e 20 72 65 6d 29 0a 20 bda (id . rem).
18f0: 20 20 20 20 20 20 28 73 65 74 21 20 72 65 73 20 (set! res
1900: 28 63 6f 6e 73 20 28 61 70 70 6c 79 20 76 65 63 (cons (apply vec
1910: 74 6f 72 20 69 64 20 72 65 6d 29 20 72 65 73 29 tor id rem) res)
1920: 29 29 0a 20 20 20 20 20 74 64 62 0a 20 20 20 20 )). tdb.
1930: 20 28 63 6f 6e 63 20 22 53 45 4c 45 43 54 20 69 (conc "SELECT i
1940: 64 2c 61 63 74 69 6f 6e 2c 6f 77 6e 65 72 2c 73 d,action,owner,s
1950: 74 61 74 65 2c 74 61 72 67 65 74 2c 6e 61 6d 65 tate,target,name
1960: 2c 74 65 73 74 2c 69 74 65 6d 2c 70 61 72 61 6d ,test,item,param
1970: 73 2c 63 72 65 61 74 69 6f 6e 5f 74 69 6d 65 2c s,creation_time,
1980: 65 78 65 63 75 74 69 6f 6e 5f 74 69 6d 65 20 0a execution_time .
1990: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 46 F
19a0: 52 4f 4d 20 74 61 73 6b 73 5f 71 75 65 75 65 20 ROM tasks_queue
19b0: 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ".
19c0: 20 3b 3b 20 57 48 45 52 45 20 20 0a 20 20 20 20 ;; WHERE .
19d0: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 20 20 ;;
19e0: 73 74 61 74 65 20 49 4e 20 22 20 73 74 61 74 65 state IN " state
19f0: 73 73 74 72 20 22 20 41 4e 44 20 0a 09 20 20 20 sstr " AND ..
1a00: 20 20 20 20 3b 3b 20 20 20 61 63 74 69 6f 6e 20 ;; action
1a10: 49 4e 20 22 20 61 63 74 69 6f 6e 73 73 74 72 20 IN " actionsstr
1a20: 0a 09 20 20 20 22 20 4f 52 44 45 52 20 42 59 20 .. " ORDER BY
1a30: 63 72 65 61 74 69 6f 6e 5f 74 69 6d 65 20 44 45 creation_time DE
1a40: 53 43 3b 22 29 29 0a 20 20 20 20 72 65 73 29 29 SC;")). res))
1a50: 0a 0a 3b 3b 20 72 65 6d 6f 76 65 20 74 61 73 6b ..;; remove task
1a60: 73 20 67 69 76 65 6e 20 62 79 20 61 20 73 74 72 s given by a str
1a70: 69 6e 67 20 6f 66 20 6e 75 6d 62 65 72 73 20 63 ing of numbers c
1a80: 6f 6d 6d 61 20 73 65 70 61 72 61 74 65 64 0a 28 omma separated.(
1a90: 64 65 66 69 6e 65 20 28 74 61 73 6b 73 3a 72 65 define (tasks:re
1aa0: 6d 6f 76 65 2d 71 75 65 75 65 2d 65 6e 74 72 69 move-queue-entri
1ab0: 65 73 20 74 64 62 20 74 61 73 6b 2d 69 64 73 29 es tdb task-ids)
1ac0: 0a 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 . (sqlite3:exec
1ad0: 75 74 65 20 74 64 62 20 28 63 6f 6e 63 20 22 44 ute tdb (conc "D
1ae0: 45 4c 45 54 45 20 46 52 4f 4d 20 74 61 73 6b 73 ELETE FROM tasks
1af0: 5f 71 75 65 75 65 20 57 48 45 52 45 20 69 64 20 _queue WHERE id
1b00: 49 4e 20 28 22 20 74 61 73 6b 2d 69 64 73 20 22 IN (" task-ids "
1b10: 29 3b 22 29 29 29 0a 0a 3b 3b 20 0a 28 64 65 66 );")))..;; .(def
1b20: 69 6e 65 20 28 74 61 73 6b 73 3a 73 74 61 72 74 ine (tasks:start
1b30: 2d 6d 6f 6e 69 74 6f 72 20 64 62 20 74 64 62 29 -monitor db tdb)
1b40: 0a 20 20 28 69 66 20 28 3e 20 28 74 61 73 6b 73 . (if (> (tasks
1b50: 3a 67 65 74 2d 6e 75 6d 2d 61 6c 69 76 65 2d 6d :get-num-alive-m
1b60: 6f 6e 69 74 6f 72 73 20 74 64 62 29 20 32 29 20 onitors tdb) 2)
1b70: 3b 3b 20 68 61 76 65 20 74 77 6f 20 72 75 6e 6e ;; have two runn
1b80: 69 6e 67 2c 20 6e 6f 20 6e 65 65 64 20 66 6f 72 ing, no need for
1b90: 20 6d 6f 72 65 0a 20 20 20 20 20 20 28 64 65 62 more. (deb
1ba0: 75 67 3a 70 72 69 6e 74 20 31 20 22 49 4e 46 4f ug:print 1 "INFO
1bb0: 3a 20 4e 6f 74 20 73 74 61 72 74 69 6e 67 20 6d : Not starting m
1bc0: 6f 6e 69 74 6f 72 2c 20 61 6c 72 65 61 64 79 20 onitor, already
1bd0: 68 61 76 65 20 6d 6f 72 65 20 74 68 61 6e 20 74 have more than t
1be0: 77 6f 20 72 75 6e 6e 69 6e 67 22 29 0a 20 20 20 wo running").
1bf0: 20 20 20 28 6c 65 74 2a 20 28 28 6d 65 67 61 74 (let* ((megat
1c00: 65 73 74 64 62 20 20 20 20 20 28 63 6f 6e 63 20 estdb (conc
1c10: 2a 74 6f 70 70 61 74 68 2a 20 22 2f 6d 65 67 61 *toppath* "/mega
1c20: 74 65 73 74 2e 64 62 22 29 29 0a 09 20 20 20 20 test.db"))..
1c30: 20 28 6d 6f 6e 69 74 6f 72 64 62 66 20 20 20 20 (monitordbf
1c40: 20 28 63 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a (conc *toppath*
1c50: 20 22 2f 6d 6f 6e 69 74 6f 72 2e 64 62 22 29 29 "/monitor.db"))
1c60: 0a 09 20 20 20 20 20 28 6c 61 73 74 2d 64 62 2d .. (last-db-
1c70: 75 70 64 61 74 65 20 30 29 29 20 3b 3b 20 28 66 update 0)) ;; (f
1c80: 69 6c 65 2d 6d 6f 64 69 66 69 63 61 74 69 6f 6e ile-modification
1c90: 2d 74 69 6d 65 20 6d 65 67 61 74 65 73 74 64 62 -time megatestdb
1ca0: 29 29 29 0a 09 28 74 61 73 6b 3a 72 65 67 69 73 )))..(task:regis
1cb0: 74 65 72 2d 6d 6f 6e 69 74 6f 72 20 74 64 62 29 ter-monitor tdb)
1cc0: 0a 09 28 6c 65 74 20 6c 6f 6f 70 20 28 28 63 6f ..(let loop ((co
1cd0: 75 6e 74 20 20 20 20 20 20 30 29 0a 09 09 20 20 unt 0)...
1ce0: 20 28 6e 65 78 74 2d 74 6f 75 63 68 20 30 29 29 (next-touch 0))
1cf0: 20 3b 3b 20 6e 65 78 74 2d 74 6f 75 63 68 20 69 ;; next-touch i
1d00: 73 20 74 68 65 20 74 69 6d 65 20 77 68 65 72 65 s the time where
1d10: 20 77 65 20 6e 65 65 64 20 74 6f 20 75 70 64 61 we need to upda
1d20: 74 65 20 6c 61 73 74 5f 75 70 64 61 74 65 0a 09 te last_update..
1d30: 20 20 3b 3b 20 69 66 20 74 68 65 20 64 62 20 68 ;; if the db h
1d40: 61 73 20 62 65 65 6e 20 6d 6f 64 69 66 69 65 64 as been modified
1d50: 20 77 65 27 64 20 62 65 73 74 20 6c 6f 6f 6b 20 we'd best look
1d60: 61 74 20 74 68 65 20 74 61 73 6b 20 71 75 65 75 at the task queu
1d70: 65 0a 09 20 20 28 6c 65 74 20 28 28 6d 6f 64 74 e.. (let ((modt
1d80: 69 6d 65 20 28 66 69 6c 65 2d 6d 6f 64 69 66 69 ime (file-modifi
1d90: 63 61 74 69 6f 6e 2d 74 69 6d 65 20 6d 65 67 61 cation-time mega
1da0: 74 65 73 74 64 62 70 61 74 68 20 29 29 29 0a 09 testdbpath )))..
1db0: 20 20 20 20 28 69 66 20 28 3e 20 6d 6f 64 74 69 (if (> modti
1dc0: 6d 65 20 6c 61 73 74 2d 64 62 2d 75 70 64 61 74 me last-db-updat
1dd0: 65 29 0a 09 09 28 74 61 73 6b 73 3a 70 72 6f 63 e)...(tasks:proc
1de0: 65 73 73 2d 71 75 65 75 65 20 64 62 20 74 64 62 ess-queue db tdb
1df0: 20 6c 61 73 74 2d 64 62 2d 75 70 64 61 74 65 20 last-db-update
1e00: 6d 65 67 61 74 65 73 74 64 62 20 6e 65 78 74 2d megatestdb next-
1e10: 74 6f 75 63 68 29 29 0a 09 20 20 20 20 3b 3b 20 touch)).. ;;
1e20: 57 41 52 4e 49 4e 47 3a 20 50 6f 73 73 69 62 6c WARNING: Possibl
1e30: 65 20 72 61 63 65 20 63 6f 6e 64 69 74 6f 6e 20 e race conditon
1e40: 68 65 72 65 21 21 0a 09 20 20 20 20 3b 3b 20 73 here!!.. ;; s
1e50: 68 6f 75 6c 64 20 74 68 69 73 20 75 70 64 61 74 hould this updat
1e60: 65 20 62 65 20 69 6d 6d 65 64 69 61 74 65 6c 79 e be immediately
1e70: 20 61 66 74 65 72 20 74 68 65 20 74 61 73 6b 2d after the task-
1e80: 67 65 74 2d 61 63 74 69 6f 6e 20 63 61 6c 6c 20 get-action call
1e90: 61 62 6f 76 65 3f 0a 09 20 20 20 20 28 69 66 20 above?.. (if
1ea0: 28 3e 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f (> (current-seco
1eb0: 6e 64 73 29 20 6e 65 78 74 2d 74 6f 75 63 68 29 nds) next-touch)
1ec0: 0a 09 09 28 62 65 67 69 6e 0a 09 09 20 20 28 74 ...(begin... (t
1ed0: 61 73 6b 73 3a 6d 6f 6e 69 74 6f 72 73 2d 75 70 asks:monitors-up
1ee0: 64 61 74 65 20 74 64 62 29 0a 09 09 20 20 28 6c date tdb)... (l
1ef0: 6f 6f 70 20 28 2b 20 63 6f 75 6e 74 20 31 29 28 oop (+ count 1)(
1f00: 2b 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e + (current-secon
1f10: 64 73 29 20 32 34 30 29 29 29 0a 09 09 28 6c 6f ds) 240)))...(lo
1f20: 6f 70 20 28 2b 20 63 6f 75 6e 74 20 31 29 20 6e op (+ count 1) n
1f30: 65 78 74 2d 74 6f 75 63 68 29 29 29 29 29 29 29 ext-touch)))))))
1f40: 0a 20 20 20 20 20 20 0a 28 64 65 66 69 6e 65 20 . .(define
1f50: 28 74 61 73 6b 73 3a 70 72 6f 63 65 73 73 2d 71 (tasks:process-q
1f60: 75 65 75 65 20 64 62 20 74 64 62 29 0a 20 20 28 ueue db tdb). (
1f70: 6c 65 74 2a 20 28 28 74 61 73 6b 20 20 20 28 74 let* ((task (t
1f80: 61 73 6b 73 3a 73 6e 61 67 2d 61 2d 74 61 73 6b asks:snag-a-task
1f90: 20 74 64 62 29 29 0a 09 20 28 61 63 74 69 6f 6e tdb)).. (action
1fa0: 20 28 69 66 20 74 61 73 6b 20 28 74 61 73 6b 73 (if task (tasks
1fb0: 3a 74 61 73 6b 2d 67 65 74 2d 61 63 74 69 6f 6e :task-get-action
1fc0: 20 74 61 73 6b 29 20 23 66 29 29 29 0a 20 20 20 task) #f))).
1fd0: 20 28 69 66 20 61 63 74 69 6f 6e 20 28 70 72 69 (if action (pri
1fe0: 6e 74 20 22 74 61 73 6b 73 3a 70 72 6f 63 65 73 nt "tasks:proces
1ff0: 73 2d 71 75 65 75 65 20 74 61 73 6b 3a 20 22 20 s-queue task: "
2000: 74 61 73 6b 29 29 0a 20 20 20 20 28 69 66 20 61 task)). (if a
2010: 63 74 69 6f 6e 0a 09 28 63 61 73 65 20 28 73 74 ction..(case (st
2020: 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 61 63 74 ring->symbol act
2030: 69 6f 6e 29 0a 09 20 20 28 28 72 75 6e 29 20 20 ion).. ((run)
2040: 20 20 20 20 20 28 74 61 73 6b 73 3a 73 74 61 72 (tasks:star
2050: 74 2d 72 75 6e 20 20 20 64 62 20 74 64 62 20 74 t-run db tdb t
2060: 61 73 6b 29 29 0a 09 20 20 28 28 72 65 6d 6f 76 ask)).. ((remov
2070: 65 29 20 20 20 20 28 74 61 73 6b 73 3a 72 65 6d e) (tasks:rem
2080: 6f 76 65 2d 72 75 6e 73 20 64 62 20 74 64 62 20 ove-runs db tdb
2090: 74 61 73 6b 29 29 0a 09 20 20 28 28 6c 6f 63 6b task)).. ((lock
20a0: 29 20 20 20 20 20 20 28 74 61 73 6b 73 3a 6c 6f ) (tasks:lo
20b0: 63 6b 2d 72 75 6e 73 20 20 20 64 62 20 74 64 62 ck-runs db tdb
20c0: 20 74 61 73 6b 29 29 0a 09 20 20 3b 3b 20 28 28 task)).. ;; ((
20d0: 6d 6f 6e 69 74 6f 72 29 20 20 20 28 74 61 73 6b monitor) (task
20e0: 73 3a 73 74 61 72 74 2d 6d 6f 6e 69 74 6f 72 20 s:start-monitor
20f0: 64 62 20 74 61 73 6b 29 29 0a 09 20 20 28 28 72 db task)).. ((r
2100: 6f 6c 6c 75 70 29 20 20 20 20 28 74 61 73 6b 73 ollup) (tasks
2110: 3a 72 6f 6c 6c 75 70 2d 72 75 6e 73 20 64 62 20 :rollup-runs db
2120: 74 64 62 20 74 61 73 6b 29 29 0a 09 20 20 28 28 tdb task)).. ((
2130: 75 70 64 61 74 65 6d 65 74 61 29 28 74 61 73 6b updatemeta)(task
2140: 73 3a 75 70 64 61 74 65 2d 6d 65 74 61 20 64 62 s:update-meta db
2150: 20 74 64 62 20 74 61 73 6b 29 29 0a 09 20 20 28 tdb task)).. (
2160: 28 6b 69 6c 6c 29 20 20 20 20 20 20 28 74 61 73 (kill) (tas
2170: 6b 73 3a 6b 69 6c 6c 2d 6d 6f 6e 69 74 6f 72 73 ks:kill-monitors
2180: 20 64 62 20 74 64 62 20 74 61 73 6b 29 29 29 29 db tdb task))))
2190: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 61 73 ))..(define (tas
21a0: 6b 73 3a 67 65 74 2d 6d 6f 6e 69 74 6f 72 73 20 ks:get-monitors
21b0: 74 64 62 29 0a 20 20 28 6c 65 74 20 28 28 72 65 tdb). (let ((re
21c0: 73 20 27 28 29 29 29 0a 20 20 20 20 28 73 71 6c s '())). (sql
21d0: 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f ite3:for-each-ro
21e0: 77 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 w. (lambda (
21f0: 61 20 2e 20 72 65 6d 29 0a 20 20 20 20 20 20 20 a . rem).
2200: 28 73 65 74 21 20 72 65 73 20 28 63 6f 6e 73 20 (set! res (cons
2210: 28 61 70 70 6c 79 20 76 65 63 74 6f 72 20 61 20 (apply vector a
2220: 72 65 6d 29 20 72 65 73 29 29 29 0a 20 20 20 20 rem) res))).
2230: 20 74 64 62 0a 20 20 20 20 20 22 53 45 4c 45 43 tdb. "SELEC
2240: 54 20 69 64 2c 70 69 64 2c 73 74 72 66 74 69 6d T id,pid,strftim
2250: 65 28 27 25 6d 2f 25 64 2f 25 59 20 25 48 3a 25 e('%m/%d/%Y %H:%
2260: 4d 27 2c 64 61 74 65 74 69 6d 65 28 73 74 61 72 M',datetime(star
2270: 74 5f 74 69 6d 65 2c 27 75 6e 69 78 65 70 6f 63 t_time,'unixepoc
2280: 68 27 29 2c 27 6c 6f 63 61 6c 74 69 6d 65 27 29 h'),'localtime')
2290: 2c 73 74 72 66 74 69 6d 65 28 27 25 6d 2f 25 64 ,strftime('%m/%d
22a0: 2f 25 59 20 25 48 3a 25 4d 3a 25 53 27 2c 64 61 /%Y %H:%M:%S',da
22b0: 74 65 74 69 6d 65 28 6c 61 73 74 5f 75 70 64 61 tetime(last_upda
22c0: 74 65 2c 27 75 6e 69 78 65 70 6f 63 68 27 29 2c te,'unixepoch'),
22d0: 27 6c 6f 63 61 6c 74 69 6d 65 27 29 2c 68 6f 73 'localtime'),hos
22e0: 74 6e 61 6d 65 2c 75 73 65 72 6e 61 6d 65 20 46 tname,username F
22f0: 52 4f 4d 20 6d 6f 6e 69 74 6f 72 73 20 4f 52 44 ROM monitors ORD
2300: 45 52 20 42 59 20 6c 61 73 74 5f 75 70 64 61 74 ER BY last_updat
2310: 65 20 41 53 43 3b 22 29 0a 20 20 20 20 28 72 65 e ASC;"). (re
2320: 76 65 72 73 65 20 72 65 73 29 0a 20 20 20 20 29 verse res). )
2330: 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 61 73 6b )..(define (task
2340: 73 3a 74 61 73 6b 73 2d 3e 74 65 78 74 20 74 61 s:tasks->text ta
2350: 73 6b 73 29 0a 20 20 28 6c 65 74 20 28 28 66 6d sks). (let ((fm
2360: 74 73 74 72 20 22 7e 31 30 61 7e 31 30 61 7e 31 tstr "~10a~10a~1
2370: 30 61 7e 31 32 61 7e 32 30 61 7e 31 32 61 7e 31 0a~12a~20a~12a~1
2380: 32 61 7e 31 32 61 7e 31 30 61 22 29 29 0a 20 20 2a~12a~10a")).
2390: 20 20 28 63 6f 6e 63 20 28 66 6f 72 6d 61 74 20 (conc (format
23a0: 23 66 20 66 6d 74 73 74 72 20 22 69 64 22 20 22 #f fmtstr "id" "
23b0: 61 63 74 69 6f 6e 22 20 22 6f 77 6e 65 72 22 20 action" "owner"
23c0: 22 73 74 61 74 65 22 20 22 74 61 72 67 65 74 22 "state" "target"
23d0: 20 22 72 75 6e 6e 61 6d 65 22 20 22 74 65 73 74 "runname" "test
23e0: 70 61 74 74 73 22 20 22 69 74 65 6d 70 61 74 74 patts" "itempatt
23f0: 73 22 20 22 70 61 72 61 6d 73 22 29 20 22 5c 6e s" "params") "\n
2400: 22 0a 09 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 ".. (string-int
2410: 65 72 73 70 65 72 73 65 20 0a 09 20 20 20 28 6d ersperse .. (m
2420: 61 70 20 28 6c 61 6d 62 64 61 20 28 74 61 73 6b ap (lambda (task
2430: 29 0a 09 09 20 20 28 66 6f 72 6d 61 74 20 23 66 )... (format #f
2440: 20 66 6d 74 73 74 72 0a 09 09 09 20 20 28 74 61 fmtstr.... (ta
2450: 73 6b 73 3a 74 61 73 6b 2d 67 65 74 2d 69 64 20 sks:task-get-id
2460: 20 20 20 20 74 61 73 6b 29 0a 09 09 09 20 20 28 task).... (
2470: 74 61 73 6b 73 3a 74 61 73 6b 2d 67 65 74 2d 61 tasks:task-get-a
2480: 63 74 69 6f 6e 20 74 61 73 6b 29 0a 09 09 09 20 ction task)....
2490: 20 28 74 61 73 6b 73 3a 74 61 73 6b 2d 67 65 74 (tasks:task-get
24a0: 2d 6f 77 6e 65 72 20 20 74 61 73 6b 29 0a 09 09 -owner task)...
24b0: 09 20 20 28 74 61 73 6b 73 3a 74 61 73 6b 2d 67 . (tasks:task-g
24c0: 65 74 2d 73 74 61 74 65 20 20 74 61 73 6b 29 0a et-state task).
24d0: 09 09 09 20 20 28 74 61 73 6b 73 3a 74 61 73 6b ... (tasks:task
24e0: 2d 67 65 74 2d 74 61 72 67 65 74 20 74 61 73 6b -get-target task
24f0: 29 0a 09 09 09 20 20 28 74 61 73 6b 73 3a 74 61 ).... (tasks:ta
2500: 73 6b 2d 67 65 74 2d 6e 61 6d 65 20 20 20 74 61 sk-get-name ta
2510: 73 6b 29 0a 09 09 09 20 20 28 74 61 73 6b 73 3a sk).... (tasks:
2520: 74 61 73 6b 2d 67 65 74 2d 74 65 73 74 20 20 20 task-get-test
2530: 74 61 73 6b 29 0a 09 09 09 20 20 28 74 61 73 6b task).... (task
2540: 73 3a 74 61 73 6b 2d 67 65 74 2d 69 74 65 6d 20 s:task-get-item
2550: 20 20 74 61 73 6b 29 0a 09 09 09 20 20 28 74 61 task).... (ta
2560: 73 6b 73 3a 74 61 73 6b 2d 67 65 74 2d 70 61 72 sks:task-get-par
2570: 61 6d 73 20 74 61 73 6b 29 29 29 0a 09 09 74 61 ams task)))...ta
2580: 73 6b 73 29 20 22 5c 6e 22 29 29 29 29 0a 20 20 sks) "\n")))).
2590: 20 0a 28 64 65 66 69 6e 65 20 28 74 61 73 6b 73 .(define (tasks
25a0: 3a 6d 6f 6e 69 74 6f 72 73 2d 3e 74 65 78 74 2d :monitors->text-
25b0: 74 61 62 6c 65 20 6d 6f 6e 69 74 6f 72 73 29 0a table monitors).
25c0: 20 20 28 6c 65 74 20 28 28 66 6d 74 73 74 72 20 (let ((fmtstr
25d0: 22 7e 34 61 7e 38 61 7e 32 30 61 7e 32 30 61 7e "~4a~8a~20a~20a~
25e0: 31 30 61 7e 31 30 61 22 29 29 0a 20 20 20 20 28 10a~10a")). (
25f0: 63 6f 6e 63 20 28 66 6f 72 6d 61 74 20 23 66 20 conc (format #f
2600: 66 6d 74 73 74 72 20 22 69 64 22 20 22 70 69 64 fmtstr "id" "pid
2610: 22 20 22 73 74 61 72 74 20 74 69 6d 65 22 20 22 " "start time" "
2620: 6c 61 73 74 20 75 70 64 61 74 65 22 20 22 68 6f last update" "ho
2630: 73 74 6e 61 6d 65 22 20 22 75 73 65 72 22 29 20 stname" "user")
2640: 22 5c 6e 22 0a 09 20 20 28 73 74 72 69 6e 67 2d "\n".. (string-
2650: 69 6e 74 65 72 73 70 65 72 73 65 20 0a 09 20 20 intersperse ..
2660: 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 6d (map (lambda (m
2670: 6f 6e 69 74 6f 72 29 0a 09 09 20 20 28 66 6f 72 onitor)... (for
2680: 6d 61 74 20 23 66 20 66 6d 74 73 74 72 0a 09 09 mat #f fmtstr...
2690: 09 20 20 28 74 61 73 6b 73 3a 6d 6f 6e 69 74 6f . (tasks:monito
26a0: 72 2d 67 65 74 2d 69 64 20 20 20 20 20 20 20 20 r-get-id
26b0: 20 20 6d 6f 6e 69 74 6f 72 29 0a 09 09 09 20 20 monitor)....
26c0: 28 74 61 73 6b 73 3a 6d 6f 6e 69 74 6f 72 2d 67 (tasks:monitor-g
26d0: 65 74 2d 70 69 64 20 20 20 20 20 20 20 20 20 6d et-pid m
26e0: 6f 6e 69 74 6f 72 29 0a 09 09 09 20 20 28 74 61 onitor).... (ta
26f0: 73 6b 73 3a 6d 6f 6e 69 74 6f 72 2d 67 65 74 2d sks:monitor-get-
2700: 73 74 61 72 74 5f 74 69 6d 65 20 20 6d 6f 6e 69 start_time moni
2710: 74 6f 72 29 0a 09 09 09 20 20 28 74 61 73 6b 73 tor).... (tasks
2720: 3a 6d 6f 6e 69 74 6f 72 2d 67 65 74 2d 6c 61 73 :monitor-get-las
2730: 74 5f 75 70 64 61 74 65 20 6d 6f 6e 69 74 6f 72 t_update monitor
2740: 29 0a 09 09 09 20 20 28 74 61 73 6b 73 3a 6d 6f ).... (tasks:mo
2750: 6e 69 74 6f 72 2d 67 65 74 2d 68 6f 73 74 6e 61 nitor-get-hostna
2760: 6d 65 20 20 20 20 6d 6f 6e 69 74 6f 72 29 0a 09 me monitor)..
2770: 09 09 20 20 28 74 61 73 6b 73 3a 6d 6f 6e 69 74 .. (tasks:monit
2780: 6f 72 2d 67 65 74 2d 75 73 65 72 6e 61 6d 65 20 or-get-username
2790: 20 20 20 6d 6f 6e 69 74 6f 72 29 29 29 0a 09 09 monitor)))...
27a0: 6d 6f 6e 69 74 6f 72 73 29 0a 09 20 20 20 22 5c monitors).. "\
27b0: 6e 22 29 29 29 29 0a 20 20 20 0a 3b 3b 20 75 70 n")))). .;; up
27c0: 64 61 74 65 20 74 68 65 20 6c 61 73 74 5f 75 70 date the last_up
27d0: 64 61 74 65 20 66 69 65 6c 64 20 77 69 74 68 20 date field with
27e0: 74 68 65 20 63 75 72 72 65 6e 74 20 74 69 6d 65 the current time
27f0: 20 61 6e 64 0a 3b 3b 20 69 66 20 61 6e 79 20 6d and.;; if any m
2800: 6f 6e 69 74 6f 72 73 20 61 70 70 65 61 72 20 64 onitors appear d
2810: 65 61 64 2c 20 72 65 6d 6f 76 65 20 74 68 65 6d ead, remove them
2820: 0a 28 64 65 66 69 6e 65 20 28 74 61 73 6b 73 3a .(define (tasks:
2830: 6d 6f 6e 69 74 6f 72 73 2d 75 70 64 61 74 65 20 monitors-update
2840: 74 64 62 29 0a 20 20 28 73 71 6c 69 74 65 33 3a tdb). (sqlite3:
2850: 65 78 65 63 75 74 65 20 74 64 62 20 22 55 50 44 execute tdb "UPD
2860: 41 54 45 20 6d 6f 6e 69 74 6f 72 73 20 53 45 54 ATE monitors SET
2870: 20 6c 61 73 74 5f 75 70 64 61 74 65 3d 73 74 72 last_update=str
2880: 66 74 69 6d 65 28 27 25 73 27 2c 27 6e 6f 77 27 ftime('%s','now'
2890: 29 20 57 48 45 52 45 20 70 69 64 3d 3f 20 41 4e ) WHERE pid=? AN
28a0: 44 20 68 6f 73 74 6e 61 6d 65 3d 3f 3b 22 0a 09 D hostname=?;"..
28b0: 09 09 20 20 28 63 75 72 72 65 6e 74 2d 70 72 6f .. (current-pro
28c0: 63 65 73 73 2d 69 64 29 0a 09 09 09 20 20 28 67 cess-id).... (g
28d0: 65 74 2d 68 6f 73 74 2d 6e 61 6d 65 29 29 0a 20 et-host-name)).
28e0: 20 28 6c 65 74 20 28 28 64 65 61 64 6c 69 73 74 (let ((deadlist
28f0: 20 27 28 29 29 29 0a 20 20 20 20 28 73 71 6c 69 '())). (sqli
2900: 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 te3:for-each-row
2910: 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 69 . (lambda (i
2920: 64 20 70 69 64 20 68 6f 73 74 20 6c 61 73 74 2d d pid host last-
2930: 75 70 64 61 74 65 20 64 65 6c 74 61 29 0a 20 20 update delta).
2940: 20 20 20 20 20 28 70 72 69 6e 74 20 22 47 6f 69 (print "Goi
2950: 6e 67 20 74 6f 20 64 65 6c 65 74 65 20 73 74 61 ng to delete sta
2960: 6c 65 20 72 65 63 6f 72 64 20 66 6f 72 20 6d 6f le record for mo
2970: 6e 69 74 6f 72 20 77 69 74 68 20 70 69 64 20 22 nitor with pid "
2980: 20 70 69 64 20 22 20 6f 6e 20 68 6f 73 74 20 22 pid " on host "
2990: 20 68 6f 73 74 20 22 20 6c 61 73 74 20 75 70 64 host " last upd
29a0: 61 74 65 64 20 22 20 64 65 6c 74 61 20 22 20 73 ated " delta " s
29b0: 65 63 6f 6e 64 73 20 61 67 6f 22 29 0a 20 20 20 econds ago").
29c0: 20 20 20 20 28 73 65 74 21 20 64 65 61 64 6c 69 (set! deadli
29d0: 73 74 20 28 63 6f 6e 73 20 69 64 20 64 65 61 64 st (cons id dead
29e0: 6c 69 73 74 29 29 29 0a 20 20 20 20 20 74 64 62 list))). tdb
29f0: 20 0a 20 20 20 20 20 22 53 45 4c 45 43 54 20 69 . "SELECT i
2a00: 64 2c 70 69 64 2c 68 6f 73 74 6e 61 6d 65 2c 6c d,pid,hostname,l
2a10: 61 73 74 5f 75 70 64 61 74 65 2c 73 74 72 66 74 ast_update,strft
2a20: 69 6d 65 28 27 25 73 27 2c 27 6e 6f 77 27 29 2d ime('%s','now')-
2a30: 6c 61 73 74 5f 75 70 64 61 74 65 20 41 53 20 64 last_update AS d
2a40: 65 6c 74 61 20 46 52 4f 4d 20 6d 6f 6e 69 74 6f elta FROM monito
2a50: 72 73 20 57 48 45 52 45 20 64 65 6c 74 61 20 3e rs WHERE delta >
2a60: 20 37 30 30 3b 22 29 0a 20 20 20 20 28 73 71 6c 700;"). (sql
2a70: 69 74 65 33 3a 65 78 65 63 75 74 65 20 74 64 62 ite3:execute tdb
2a80: 20 28 63 6f 6e 63 20 22 44 45 4c 45 54 45 20 46 (conc "DELETE F
2a90: 52 4f 4d 20 6d 6f 6e 69 74 6f 72 73 20 57 48 45 ROM monitors WHE
2aa0: 52 45 20 69 64 20 49 4e 20 28 27 22 20 28 73 74 RE id IN ('" (st
2ab0: 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 ring-intersperse
2ac0: 20 28 6d 61 70 20 63 6f 6e 63 20 64 65 61 64 6c (map conc deadl
2ad0: 69 73 74 29 20 22 27 2c 27 22 29 20 22 27 29 3b ist) "','") "');
2ae0: 22 29 29 29 0a 20 20 29 0a 0a 28 64 65 66 69 6e "))). )..(defin
2af0: 65 20 28 74 61 73 6b 73 3a 72 65 6d 6f 76 65 2d e (tasks:remove-
2b00: 6d 6f 6e 69 74 6f 72 2d 72 65 63 6f 72 64 20 74 monitor-record t
2b10: 64 62 29 0a 20 20 28 73 71 6c 69 74 65 33 3a 65 db). (sqlite3:e
2b20: 78 65 63 75 74 65 20 74 64 62 20 22 44 45 4c 45 xecute tdb "DELE
2b30: 54 45 20 46 52 4f 4d 20 6d 6f 6e 69 74 6f 72 73 TE FROM monitors
2b40: 20 57 48 45 52 45 20 70 69 64 3d 3f 20 41 4e 44 WHERE pid=? AND
2b50: 20 68 6f 73 74 6e 61 6d 65 3d 3f 3b 22 0a 09 09 hostname=?;"...
2b60: 20 20 20 28 63 75 72 72 65 6e 74 2d 70 72 6f 63 (current-proc
2b70: 65 73 73 2d 69 64 29 0a 09 09 20 20 20 28 67 65 ess-id)... (ge
2b80: 74 2d 68 6f 73 74 2d 6e 61 6d 65 29 29 29 0a 0a t-host-name)))..
2b90: 28 64 65 66 69 6e 65 20 28 74 61 73 6b 73 3a 73 (define (tasks:s
2ba0: 65 74 2d 73 74 61 74 65 20 74 64 62 20 74 61 73 et-state tdb tas
2bb0: 6b 2d 69 64 20 73 74 61 74 65 29 0a 20 20 28 73 k-id state). (s
2bc0: 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 74 qlite3:execute t
2bd0: 64 62 20 22 55 50 44 41 54 45 20 74 61 73 6b 73 db "UPDATE tasks
2be0: 5f 71 75 65 75 65 20 53 45 54 20 73 74 61 74 65 _queue SET state
2bf0: 3d 3f 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 20 =? WHERE id=?;"
2c00: 0a 09 09 20 20 20 73 74 61 74 65 20 0a 09 09 20 ... state ...
2c10: 20 20 74 61 73 6b 2d 69 64 29 29 0a 0a 3b 3b 3d task-id))..;;=
2c20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2c30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2c40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2c50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2c60: 3d 3d 3d 3d 3d 0a 3b 3b 20 54 68 65 20 72 6f 75 =====.;; The rou
2c70: 74 69 6e 65 73 20 74 6f 20 70 72 6f 63 65 73 73 tines to process
2c80: 20 74 61 73 6b 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d tasks.;;=======
2c90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2ca0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2cb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2cc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
2cd0: 0a 3b 3b 20 4e 4f 54 45 3a 20 49 74 20 6d 69 67 .;; NOTE: It mig
2ce0: 68 74 20 62 65 20 67 6f 6f 64 20 74 6f 20 61 64 ht be good to ad
2cf0: 64 20 6f 6e 65 20 6d 6f 72 65 20 6c 61 79 65 72 d one more layer
2d00: 20 6f 66 20 63 68 65 63 6b 69 6e 67 20 74 6f 20 of checking to
2d10: 65 6e 73 75 72 65 0a 3b 3b 20 20 20 20 20 20 20 ensure.;;
2d20: 74 68 61 74 20 6e 6f 20 74 61 73 6b 20 67 65 74 that no task get
2d30: 73 20 72 75 6e 20 69 6e 20 70 61 72 61 6c 6c 65 s run in paralle
2d40: 6c 2e 0a 0a 28 64 65 66 69 6e 65 20 28 74 61 73 l...(define (tas
2d50: 6b 73 3a 73 74 61 72 74 2d 72 75 6e 20 64 62 20 ks:start-run db
2d60: 74 64 62 20 74 61 73 6b 29 0a 20 20 28 6c 65 74 tdb task). (let
2d70: 20 28 28 66 6c 61 67 73 20 28 6d 61 6b 65 2d 68 ((flags (make-h
2d80: 61 73 68 2d 74 61 62 6c 65 29 29 29 0a 20 20 20 ash-table))).
2d90: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 (hash-table-set
2da0: 21 20 66 6c 61 67 73 20 22 2d 72 65 72 75 6e 22 ! flags "-rerun"
2db0: 20 22 4e 4f 54 5f 53 54 41 52 54 45 44 22 29 0a "NOT_STARTED").
2dc0: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 73 74 (if (not (st
2dd0: 72 69 6e 67 3d 3f 20 28 74 61 73 6b 73 3a 74 61 ring=? (tasks:ta
2de0: 73 6b 2d 67 65 74 2d 70 61 72 61 6d 73 20 74 61 sk-get-params ta
2df0: 73 6b 29 20 22 22 29 29 0a 09 28 68 61 73 68 2d sk) ""))..(hash-
2e00: 74 61 62 6c 65 2d 73 65 74 21 20 66 6c 61 67 73 table-set! flags
2e10: 20 22 2d 73 65 74 76 61 72 73 22 20 28 74 61 73 "-setvars" (tas
2e20: 6b 73 3a 74 61 73 6b 2d 67 65 74 2d 70 61 72 61 ks:task-get-para
2e30: 6d 73 20 74 61 73 6b 29 29 29 0a 20 20 20 20 28 ms task))). (
2e40: 70 72 69 6e 74 20 22 53 74 61 72 74 69 6e 67 20 print "Starting
2e50: 72 75 6e 20 22 20 74 61 73 6b 29 0a 20 20 20 20 run " task).
2e60: 3b 3b 20 73 69 6c 6c 79 6e 65 73 73 2c 20 6a 75 ;; sillyness, ju
2e70: 73 74 20 63 61 6c 6c 20 74 68 65 20 64 61 6d 6e st call the damn
2e80: 20 72 6f 75 74 69 6e 65 20 77 69 74 68 20 74 68 routine with th
2e90: 65 20 74 61 73 6b 20 76 65 63 74 6f 72 20 61 6e e task vector an
2ea0: 64 20 62 65 20 64 6f 6e 65 20 77 69 74 68 20 69 d be done with i
2eb0: 74 2e 20 46 49 58 4d 45 20 53 4f 4d 45 44 41 59 t. FIXME SOMEDAY
2ec0: 0a 20 20 20 20 28 72 75 6e 73 3a 72 75 6e 2d 74 . (runs:run-t
2ed0: 65 73 74 73 20 64 62 0a 09 09 20 20 20 20 28 74 ests db... (t
2ee0: 61 73 6b 73 3a 74 61 73 6b 2d 67 65 74 2d 74 61 asks:task-get-ta
2ef0: 72 67 65 74 20 74 61 73 6b 29 0a 09 09 20 20 20 rget task)...
2f00: 20 28 74 61 73 6b 73 3a 74 61 73 6b 2d 67 65 74 (tasks:task-get
2f10: 2d 6e 61 6d 65 20 20 20 74 61 73 6b 29 0a 09 09 -name task)...
2f20: 20 20 20 20 28 74 61 73 6b 73 3a 74 61 73 6b 2d (tasks:task-
2f30: 67 65 74 2d 74 65 73 74 20 20 20 74 61 73 6b 29 get-test task)
2f40: 0a 09 09 20 20 20 20 28 74 61 73 6b 73 3a 74 61 ... (tasks:ta
2f50: 73 6b 2d 67 65 74 2d 69 74 65 6d 20 20 20 74 61 sk-get-item ta
2f60: 73 6b 29 0a 09 09 20 20 20 20 28 74 61 73 6b 73 sk)... (tasks
2f70: 3a 74 61 73 6b 2d 67 65 74 2d 6f 77 6e 65 72 20 :task-get-owner
2f80: 20 74 61 73 6b 29 0a 09 09 20 20 20 20 66 6c 61 task)... fla
2f90: 67 73 29 0a 20 20 20 20 28 74 61 73 6b 73 3a 73 gs). (tasks:s
2fa0: 65 74 2d 73 74 61 74 65 20 74 64 62 20 28 74 61 et-state tdb (ta
2fb0: 73 6b 73 3a 74 61 73 6b 2d 67 65 74 2d 69 64 20 sks:task-get-id
2fc0: 74 61 73 6b 29 20 22 77 61 69 74 69 6e 67 22 29 task) "waiting")
2fd0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 61 73 ))..(define (tas
2fe0: 6b 73 3a 72 6f 6c 6c 75 70 2d 72 75 6e 73 20 64 ks:rollup-runs d
2ff0: 62 20 74 64 62 20 74 61 73 6b 29 0a 20 20 28 6c b tdb task). (l
3000: 65 74 2a 20 28 28 66 6c 61 67 73 20 28 6d 61 6b et* ((flags (mak
3010: 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 20 0a e-hash-table)) .
3020: 09 20 28 6b 65 79 73 20 20 28 64 62 3a 67 65 74 . (keys (db:get
3030: 2d 6b 65 79 73 20 64 62 29 29 0a 09 20 28 6b 65 -keys db)).. (ke
3040: 79 76 61 6c 6c 73 74 20 28 6b 65 79 73 3a 74 61 yvallst (keys:ta
3050: 72 67 65 74 2d 3e 6b 65 79 76 61 6c 20 6b 65 79 rget->keyval key
3060: 73 20 28 74 61 73 6b 73 3a 74 61 73 6b 2d 67 65 s (tasks:task-ge
3070: 74 2d 74 61 72 67 65 74 20 74 61 73 6b 29 29 29 t-target task)))
3080: 29 0a 20 20 20 20 3b 3b 20 28 68 61 73 68 2d 74 ). ;; (hash-t
3090: 61 62 6c 65 2d 73 65 74 21 20 66 6c 61 67 73 20 able-set! flags
30a0: 22 2d 72 65 72 75 6e 22 20 22 4e 4f 54 5f 53 54 "-rerun" "NOT_ST
30b0: 41 52 54 45 44 22 29 0a 20 20 20 20 28 70 72 69 ARTED"). (pri
30c0: 6e 74 20 22 53 74 61 72 74 69 6e 67 20 72 6f 6c nt "Starting rol
30d0: 6c 75 70 20 22 20 74 61 73 6b 29 0a 20 20 20 20 lup " task).
30e0: 3b 3b 20 73 69 6c 6c 79 6e 65 73 73 2c 20 6a 75 ;; sillyness, ju
30f0: 73 74 20 63 61 6c 6c 20 74 68 65 20 64 61 6d 6e st call the damn
3100: 20 72 6f 75 74 69 6e 65 20 77 69 74 68 20 74 68 routine with th
3110: 65 20 74 61 73 6b 20 76 65 63 74 6f 72 20 61 6e e task vector an
3120: 64 20 62 65 20 64 6f 6e 65 20 77 69 74 68 20 69 d be done with i
3130: 74 2e 20 46 49 58 4d 45 20 53 4f 4d 45 44 41 59 t. FIXME SOMEDAY
3140: 0a 20 20 20 20 28 72 75 6e 73 3a 72 6f 6c 6c 75 . (runs:rollu
3150: 70 2d 72 75 6e 20 64 62 0a 09 09 20 20 20 20 20 p-run db...
3160: 6b 65 79 73 20 0a 09 09 20 20 20 20 20 6b 65 79 keys ... key
3170: 76 61 6c 6c 73 74 0a 09 09 20 20 20 20 20 28 74 vallst... (t
3180: 61 73 6b 73 3a 74 61 73 6b 2d 67 65 74 2d 6e 61 asks:task-get-na
3190: 6d 65 20 20 74 61 73 6b 29 0a 09 09 20 20 20 20 me task)...
31a0: 20 28 74 61 73 6b 73 3a 74 61 73 6b 2d 67 65 74 (tasks:task-get
31b0: 2d 6f 77 6e 65 72 20 20 74 61 73 6b 29 29 0a 20 -owner task)).
31c0: 20 20 20 28 74 61 73 6b 73 3a 73 65 74 2d 73 74 (tasks:set-st
31d0: 61 74 65 20 74 64 62 20 28 74 61 73 6b 73 3a 74 ate tdb (tasks:t
31e0: 61 73 6b 2d 67 65 74 2d 69 64 20 74 61 73 6b 29 ask-get-id task)
31f0: 20 22 77 61 69 74 69 6e 67 22 29 29 29 0a "waiting"))).