Megatest

Check-in [b5f1f35f26]
Login
Overview
Comment:fix port setting
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.80-processes
Files: files | file ages | folders
SHA1: b5f1f35f262c1301fe85564c98525572ebdd3225
User & Date: matt on 2023-10-09 19:38:11
Other Links: branch diff | manifest | tags
Context
2023-11-10
19:49
Last seemingly good commit on all platforms. check-in: 1d9da3b7a0 user: matt tags: v1.80-revolution
2023-10-09
19:51
Merged v1.80 in check-in: 38506ffe03 user: matt tags: v1.80
19:38
fix port setting Leaf check-in: b5f1f35f26 user: matt tags: v1.80-processes
10:59
Added force-init to db open proc. check-in: b1a043e49f user: mrwellan tags: v1.80-processes
Changes

Modified dbfile.scm from [7031e7a58e] to [4b315f3788].

144
145
146
147
148
149
150

151
152
153

154
155
156
157
158
159
160
144
145
146
147
148
149
150
151
152
153

154
155
156
157
158
159
160
161







+


-
+







     (else
      "nopurpose"))))

;; megatest process tracking

(defstruct procinf
  (start      (current-seconds))
  (end        -1)
  (host       (get-host-name)) ;; why is this not being recognised?
  (pid        (current-process-id))
  (port       #f)
  (port       -1)
  (cwd        (current-directory))
  (load       #f)
  (purpose    #f) ;; get-purpose needed to be run in megatest.scm
  (dbname     #f)
  (mtbin      (car (argv)))
  (mtversion  #f)
  (status     "running")
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



578
579
580
581
582
583
584
585
586
587
588
589

590
591
592
593
594
595
596
597
598
599

600
601
602
603
604
605
606
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



578
579
580
581
582
583
584
585
586
587
588
589
590
591

592
593
594
595
596
597
598
599
600
601

602
603
604
605
606
607
608
609







-
+


-
+




+














+






-
-
-
+
+
+











-
+









-
+








(define (dbfile:insert-or-update-process nsdb dat)
  (let* ((host      (procinf-host dat))
	 (pid       (procinf-pid  dat))
	 (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)
	  ((host port pid starttime endtime status purpose dbname mtversion)
	   (sqlite3:execute
	    nsdb
	    "UPDATE processes SET port=?,starttime=?,status=?,
	    "UPDATE processes SET port=?,starttime=?,endtime=?,status=?,
                                  purpose=?,dbname=?,mtversion=?
              WHERE host=? AND pid=?;"
	    (or (procinf-port      dat) port)
	    (or (procinf-start     dat) starttime)
	    (or (procinf-end       dat) endtime)
	    (or (procinf-status    dat) status)
	    (or (procinf-purpose   dat) purpose)
	    (or (procinf-dbname    dat) dbname)
	    (or (procinf-mtversion dat) mtversion)
	    host pid))
	  (else
	   #f ;; what to do?
	   ))
	(dbfile:register-process
	 nsdb
	 (procinf-host      dat)
	 (procinf-port      dat)
	 (procinf-pid       dat)
	 (procinf-start     dat)
	 (procinf-end       dat)
	 (procinf-status    dat)
	 (procinf-purpose   dat)
	 (procinf-dbname    dat)
	 (procinf-mtversion dat)))))
	  

(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:register-process nsdb host port pid starttime endtime status purpose dbname mtversion)
  (sqlite3:execute nsdb "INSERT INTO processes (host,port,pid,starttime,endtime,status,purpose,dbname,mtversion) VALUES (?,?,?,?,?,?,?,?,?);"
		   host port pid starttime endtime 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';"
   "SELECT host,port,pid,starttime,endtime,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,mtversion FROM processes WHERE host=? AND pid=?;"
	      "SELECT host,port,pid,starttime,endtime,status,purpose,dbname,mtversion 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)

Modified tcp-transportmod.scm from [4487a83d10] to [a1fcad65c5].

481
482
483
484
485
486
487
488
489
490




















491
492
493
494
495
496
497
498
499
500
501
502
503


504
505
506
507
508
509
510
481
482
483
484
485
486
487

488
489
490
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
522







-


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




-
-
-
-
-
-
-
-
-
+
+







			      "tcp-server-thread"))
		 (run-thread (make-thread
			      (lambda ()
				(tt:keep-running ttdat dbfname dbstruct)))))
	    (thread-start! tcp-thread)
	    (thread-start! run-thread)

	    (procinf-port-set! *procinf* (tt-port ttdat))
	    (let* ((areapath     (tt-areapath ttdat))
		   (nosyncdbpath (conc areapath"/.mtdb")))
	      ;; this didn't seem to work, is port not available yet?
	      (let loop ((count 0))
		(if (tt-port ttdat)
		    (begin
		      (procinf-port-set! *procinf* (tt-port ttdat))
		      (procinf-dbname-set! *procinf* dbfname)
		      (dbfile:with-no-sync-db
		       nosyncdbpath
		       (lambda (nsdb)
			 (dbfile:insert-or-update-process nsdb *procinf*))))
		    (if (< count 5)
			(begin
			  (thread-sleep! 0.5)
			  (loop (+ count 1)))
			(debug:print 0 *default-log-port* "ERROR: (tt-port ttdat) no port set!"))))
	    
	      (thread-join! run-thread) ;; run thread will exit on timeout or other conditions
	      ;; replace with call to (dbfile:set-process-done nsdb host pid reason)
	      (procinf-status-set! *procinf* "done")
	      (procinf-end-set! *procinf* (current-seconds))
	      (dbfile:with-no-sync-db
	       nosyncdbpath
	       (lambda (nsdb)
		 (dbfile:insert-or-update-process nsdb *procinf*)))
	    
	      (thread-join! run-thread) ;; run thread will exit on timeout or other conditions
	      (procinf-status-set! *procinf* "done")
	      (dbfile:with-no-sync-db
	       nosyncdbpath
	       (lambda (nsdb)
		 (dbfile:insert-or-update-process nsdb *procinf*))))
            (debug:print 0 *default-log-port* "Exiting now.")
	    (exit))))))
              (debug:print 0 *default-log-port* "Exiting now.")
	      (exit)))))))

(define (tt:keep-running ttdat dbfname dbstruct)
  ;; verfiy conn for ready
  ;; listener socket has been started by this stage
  ;; wait for a port before creating the registration file
  ;;
  (let* ((db-locked-in #f)