Megatest

Diff
Login

Differences From Artifact [059408bffa]:

To Artifact [c8e0f86792]:


49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68


69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87



















88
89
90
91
92
93
94
95
96
97
98

99
100
101
102
103
104
105

106
107
108
109
110
111
112
113
114
115
116
117
118
119


120
121
122
123
124
125
126
127
128


129
130

131
132

133
134
135
136
137
138

139
140
141
142
143
144
145
49
50
51
52
53
54
55



56
57
58
59
60
61
62
63
64
65
66
67



















68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96

97
98
99
100
101
102
103

104
105
106
107
108
109
110
111
112
113
114
115
116


117
118
119
120
121
122
123
124
125


126
127


128


129






130
131
132
133
134
135
136
137







-
-
-










+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+










-
+






-
+












-
-
+
+







-
-
+
+
-
-
+
-
-
+
-
-
-
-
-
-
+







(define (tasks:get-task-db-path)
  (if *task-db*
      (vector-ref *task-db* 1)
      (let* ((linktree     (configf:lookup *configdat* "setup" "linktree"))
	     (dbpath       (conc linktree "/.db/monitor.db")))
	dbpath)))

(define (tasks:wait-on-busy-monitor.db)
  (tasks:wait-on-journal (tasks:get-task-db-path) 30))

;; If file exists AND
;;    file readable
;;         ==> open it
;; If file exists AND
;;    file NOT readable
;;         ==> open in-mem version
;; If file NOT exists
;;    ==> open in-mem version
;;
(define (tasks:open-db)
  (if *task-db*
      *task-db*
  (let* ((dbpath       (tasks:get-task-db-path))
	 (avail        (tasks:wait-on-journal dbpath 10)) ;; wait up to about 10 seconds for the journal to go away
	 (exists       (file-exists? dbpath))
	 (write-access (file-write-access? dbpath))
	 (mdb          (cond
			((file-write-access? *toppath*)(sqlite3:open-database dbpath))
			((file-read-access? dbpath)    (sqlite3:open-database dbpath))
			(else (sqlite3:open-database ":memory:")))) ;; (never-give-up-open-db dbpath))
	 (handler      (make-busy-timeout 36000)))
    (if (and exists
	     (not write-access))
	(set! *db-write-access* write-access)) ;; only unset so other db's also can use this control
    (sqlite3:set-busy-handler! mdb handler)
    (sqlite3:execute mdb (conc "PRAGMA synchronous = 0;"))
    (if (or (and (not exists)
		 (file-write-access? *toppath*))
	    (not (file-read-access? dbpath)))
	(begin
	  (sqlite3:execute mdb "CREATE TABLE IF NOT EXISTS tasks_queue (id INTEGER PRIMARY KEY,
      (let* ((dbpath       (tasks:get-task-db-path))
	     (avail        (tasks:wait-on-journal dbpath 10)) ;; wait up to about 10 seconds for the journal to go away
	     (exists       (file-exists? dbpath))
	     (write-access (file-write-access? dbpath))
	     (mdb          (cond
			    ((file-write-access? *toppath*)(sqlite3:open-database dbpath))
			    ((file-read-access? dbpath)    (sqlite3:open-database dbpath))
			    (else (sqlite3:open-database ":memory:")))) ;; (never-give-up-open-db dbpath))
	     (handler      (make-busy-timeout 36000)))
	(if (and exists
		 (not write-access))
	    (set! *db-write-access* write-access)) ;; only unset so other db's also can use this control
	(sqlite3:set-busy-handler! mdb handler)
	(sqlite3:execute mdb (conc "PRAGMA synchronous = 0;"))
	(if (or (and (not exists)
		     (file-write-access? *toppath*))
		(not (file-read-access? dbpath)))
	    (begin
	      (sqlite3:execute mdb "CREATE TABLE IF NOT EXISTS tasks_queue (id INTEGER PRIMARY KEY,
                                action TEXT DEFAULT '',
                                owner TEXT,
                                state TEXT DEFAULT 'new',
                                target TEXT DEFAULT '',
                                name TEXT DEFAULT '',
                                testpatt TEXT DEFAULT '',
                                keylock TEXT,
                                params TEXT,
                                creation_time TIMESTAMP,
                                execution_time TIMESTAMP);")
	  (sqlite3:execute mdb "CREATE TABLE IF NOT EXISTS monitors (id INTEGER PRIMARY KEY,
	      (sqlite3:execute mdb "CREATE TABLE IF NOT EXISTS monitors (id INTEGER PRIMARY KEY,
                                pid INTEGER,
                                start_time TIMESTAMP,
                                last_update TIMESTAMP,
                                hostname TEXT,
                                username TEXT,
                               CONSTRAINT monitors_constraint UNIQUE (pid,hostname));")
	  (sqlite3:execute mdb "CREATE TABLE IF NOT EXISTS servers (id INTEGER PRIMARY KEY,
	      (sqlite3:execute mdb "CREATE TABLE IF NOT EXISTS servers (id INTEGER PRIMARY KEY,
                                  pid INTEGER,
                                  interface TEXT,
                                  hostname TEXT,
                                  port INTEGER,
                                  pubport INTEGER,
                                  start_time TIMESTAMP,
                                  priority INTEGER,
                                  state TEXT,
                                  mt_version TEXT,
                                  heartbeat TIMESTAMP,
                                  transport TEXT,
                                  run_id INTEGER);")
;;                               CONSTRAINT servers_constraint UNIQUE (pid,hostname,port));")
	  (sqlite3:execute mdb "CREATE TABLE IF NOT EXISTS clients (id INTEGER PRIMARY KEY,
	      ;;                               CONSTRAINT servers_constraint UNIQUE (pid,hostname,port));")
	      (sqlite3:execute mdb "CREATE TABLE IF NOT EXISTS clients (id INTEGER PRIMARY KEY,
                                  server_id INTEGER,
                                  pid INTEGER,
                                  hostname TEXT,
                                  cmdline TEXT,
                                  login_time TIMESTAMP,
                                  logout_time TIMESTAMP DEFAULT -1,
                                CONSTRAINT clients_constraint UNIQUE (pid,hostname));")
                                  
	  ))
	      
	      ))
    mdb))

	(set! *task-db* (cons mdb dbpath))
(define (tasks:get-db)
  (if *task-db*
	*task-db*)))
      (vector-ref *task-db* 0)
      (let ((db  (tasks:open-db))
	    (pth (tasks:get-task-db-path)))
	(set! *task-db* (vector db pth))
	db)))
  

;;======================================================================
;; Server and client management
;;======================================================================

;; make-vector-record tasks hostinfo id interface port pubport transport pid hostname
(define (tasks:hostinfo-get-id          vec)    (vector-ref  vec 0))
(define (tasks:hostinfo-get-interface   vec)    (vector-ref  vec 1))
350
351
352
353
354
355
356
357
358


359
360
361
362
363
364
365

366
367


368
369
370
371
372
373
374
342
343
344
345
346
347
348


349
350
351
352
353
354
355
356

357
358

359
360
361
362
363
364
365
366
367







-
-
+
+






-
+

-
+
+







  (system (conc "nbfake kill " pid))
  (unsetenv "TARGETHOST_LOGF")
  (unsetenv "TARGETHOST"))
 
;; look up a server by run-id and send it a kill, also delete the record for that server
;;
(define (tasks:kill-server-run-id run-id #!key (tag "default"))
  (let* ((tdb  (tasks:open-db))
	 (sdat (tasks:get-server tdb run-id)))
  (let* ((tdbdat  (tasks:open-db))
	 (sdat    (tasks:get-server (db:delay-if-busy tdbdat) run-id)))
    (if sdat
	(let ((hostname (vector-ref sdat 6))
	      (pid      (vector-ref sdat 5))
	      (server-id (vector-ref sdat 0)))
	  (debug:print-info 0 "Killing server " server-id " for run-id " run-id " on host " hostname " with pid " pid)
	  (tasks:kill-server hostname pid)
	  (tasks:server-delete-record tdb server-id tag) )
	  (tasks:server-delete-record (db:delay-if-busy tdbdat) server-id tag) )
	(debug:print-info 0 "No server found for run-id " run-id ", nothing to kill"))
    (sqlite3:finalize! tdb)))
    ;; (sqlite3:finalize! tdb)
    ))
    
;;   (if status ;; #t means alive
;;       (begin
;; 	(if (equal? hostname (get-host-name))
;; 	    (handle-exceptions
;; 	     exn
;; 	     (debug:print-info 0 "server may or may not be dead, check for megatest -server running as pid " pid "\n"