Megatest

Check-in [119cfc1040]
Login
Overview
Comment:fixed uses in dbfile
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.80-processes
Files: files | file ages | folders
SHA1: 119cfc1040e4a653bed16bf59d8d41c87c609023
User & Date: mrwellan on 2023-10-02 19:56:19
Other Links: branch diff | manifest | tags
Context
2023-10-05
05:24
wip check-in: 88ce699176 user: matt tags: v1.80-processes
2023-10-02
19:56
fixed uses in dbfile check-in: 119cfc1040 user: mrwellan tags: v1.80-processes
07:00
Process registration now working check-in: 169e4f3073 user: matt tags: v1.80-processes
Changes

Modified dbfile.scm from [24616e6fd1] to [b9031adaf7].

14
15
16
17
18
19
20
21

22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37

38
39
40
41
42
43
44

45
46
47
48
49
50
51
14
15
16
17
18
19
20

21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36

37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52







-
+















-
+







+







;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================

(use srfi-18)
(use srfi-18 posix hostinfo)

(declare (unit dbfile))
(declare (uses debugprint))
(declare (uses commonmod))

(module dbfile
	*
	
  (import scheme
	  chicken
	  data-structures
	  extras
	  matchable
  
	  (prefix sqlite3 sqlite3:)
	  posix typed-records
	  posix posix-extras typed-records

	  srfi-18
	  srfi-1
	  srfi-69
	  stack
	  files
	  ports
	  hostinfo
	  
	  commonmod
	  debugprint
	  )

;; parameters
;;
119
120
121
122
123
124
125



















126
127
128
129
130
131
132
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
146
147
148
149
150
151
152







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








;; used in simple-get-runs (thanks Brandon!)
(define-record simple-run target id runname state status owner event_time)
(define-record-printer (simple-run x out)
  (fprintf out "#,(simple-run ~S ~S ~S ~S)"
	   (simple-run-target x) (simple-run-id x) (simple-run-runname x) (time->string (seconds->local-time (simple-run-event_time x) ))))

;; megatest process tracking

(defstruct pinf
  (start (current-seconds))
  (host  (get-host-name)) ;; why is this not being recognised?
  (pid   (current-process-id))
  (port  #f)
  (cwd   (current-directory))
  (load   #f)
  (purpose #f) ;; get-purpose needed
  (dbname   #f)
  (mtbin (car (argv)))
  (mtversion #f)
  (status   "running")
  
  
  )

(define *pinf* (make-pinf))
(define *dbstruct-dbs* #f)
(define *db-open-mutex* (make-mutex))
(define *db-access-mutex* (make-mutex)) ;; used in common.scm
(define *no-sync-db*   #f)
(define *db-sync-in-progress* #f)
(define *db-with-db-mutex*    (make-mutex))
(define *max-api-process-requests* 0)
491
492
493
494
495
496
497























498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514













515
516
517
518
519
520
521
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

















+
+
+
+
+
+
+
+
+
+
+
+
+







    (if on-tmp	      ;; done in cautious-open-database
	(begin
	  (sqlite3:execute db "PRAGMA synchronous = 0;")
	  (sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 136000))))
    db))

;; processes table calls

(define (dbfile:insert-or-update-process nsdb pinfdat)
  (let* ((host  (pinf-host pinfdat))
	 (pid   (pinf-pid  pinfdat))
	 (curr-info (dbfile:get-process-info nsdb host pid)))
    (if curr-info ;; record exists, do update
	(match curr-info
	  ((host port pid starttime status purpose dbname mtversion)
	   (dbfile:register-process nsdb host port pid starttime status purpose dbname mtversion))
	  (else
	   #f ;; what to do?
	   ))
	(dbfile:register-process
	 nsdb
	 (pinf-host      pinfdat)
	 (pinf-port      pinfdat)
	 (pinf-pid       pinfdat)
	 (pinf-start     pinfdat)
	 (pinf-status    pinfdat)
	 (pinf-purpose   pinfdat)
	 (pinf-dbname    pinfdat)
	 (pinf-mtversion pinfdat)))))
	  

(define (dbfile:register-process nsdb host port pid starttime status purpose dbname mtversion)
  (sqlite3:execute nsdb "INSERT INTO processes (host,port,pid,starttime,status,purpose,dbname,mtversion) VALUES (?,?,?,?,?,?,?,?);"
		   host port pid starttime status purpose dbname mtversion))

(define (dbfile:set-process-status nsdb host pid newstatus)
  (sqlite3:execute nsdb "UPDATE processes SET status=? WHERE host=? AND pid=?;" newstatus host pid))

(define (dbfile:get-process-options nsdb purpose dbname)
  (sqlite3:fold-row
   ;; host port pid starttime status mtversion
   (lambda (res . row)
     (cons row res))
   '()
   nsdb
   "SELECT host,port,pid,starttime,status,mtversion FROM processes WHERE purpose=? AND dbname LIKE ? AND status='alive';"
   purpose dbname))

(define (dbfile:get-process-info nsdb host pid)
  (let ((res (sqlite3:fold-row
	      ;; host port pid starttime status mtversion
	      (lambda (res . row)
		(cons row res))
	      '()
	      nsdb
	      "SELECT (host,port,pid,starttime,status,purpose,dbname,mtversionn FROM processes WHERE host=? AND pid=?;"
	      host pid)))
    (if (null? res)
	#f
	(car res))))

(define (dbfile:set-process-done nsdb host pid reason)
  (sqlite3:execute nsdb "UPDATE processes SET status='ended',endtime=?,reason=? WHERE host=? AND pid=?;" (current-seconds) reason host pid)
  (dbfile:cleanup-old-entries nsdb))

(define (dbfile:cleanup-old-entries nsdb)
  (sqlite3:execute nsdb "DELETE FROM process WHERE status='ended' AND endtime<?;" (- (current-seconds) (* 3600 48))))

Modified launch.scm from [9d838959e9] to [470997d4b0].

30
31
32
33
34
35
36
37
38
39



40
41
42
43
44
45
46
30
31
32
33
34
35
36



37
38
39
40
41
42
43
44
45
46







-
-
-
+
+
+







(declare (uses db))
(declare (uses rmtmod))
(declare (uses ezsteps))
;; (declare (uses dbmod))
(declare (uses dbfile))
(declare (uses mtargs))

(use regex regex-case base64 sqlite3 srfi-18 directory-utils posix-extras z3
     call-with-environment-variables csv)
(use typed-records pathname-expand matchable)
(use regex regex-case base64 sqlite3 srfi-18 directory-utils posix posix-extras z3
     call-with-environment-variables csv hostinfo 
     typed-records pathname-expand matchable)

(import (prefix base64 base64:)
	(prefix sqlite3 sqlite3:)
	(prefix mtargs args:)
)

(include "common_records.scm")