Megatest

Check-in [e9b993efa1]
Login
Overview
Comment:Registering of a server works
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.80-processes
Files: files | file ages | folders
SHA1: e9b993efa1861910a6d19be61c9e50ee3d8a30c2
User & Date: matt on 2023-10-06 20:44:58
Other Links: branch diff | manifest | tags
Context
2023-10-09
10:59
Added force-init to db open proc. check-in: b1a043e49f user: mrwellan tags: v1.80-processes
2023-10-06
20:44
Registering of a server works check-in: e9b993efa1 user: matt tags: v1.80-processes
2023-10-05
21:16
Added beginnings of purpose finding function check-in: 6f2e80f7e6 user: matt tags: v1.80-processes
Changes

Modified dbfile.scm from [18c7809e20] to [56a00649be].

590
591
592
593
594
595
596
597

598
599
600
601
602
603
604
590
591
592
593
594
595
596

597
598
599
600
601
602
603
604







-
+







(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=?;"
	      "SELECT host,port,pid,starttime,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 megatest.scm from [429d7d2934] to [f7c0fef20e].

539
540
541
542
543
544
545





546
547
548
549
550
551
552
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557







+
+
+
+
+







	  (exit 1))))

;; immediately set MT_TARGET if -reqtarg or -target are available
;;
(let ((targ (or (args:get-arg "-reqtarg")(args:get-arg "-target"))))
  (if targ (setenv "MT_TARGET" targ)))

;; set the purpose field in procinf

(procinf-purpose-set! *procinf* (get-purpose args:arg-hash))
(procinf-mtversion-set! *procinf* megatest-version)

;; The watchdog is to keep an eye on things like db sync etc.
;;

;; TODO: for multiple areas, we will have multiple watchdogs; and multiple threads to manage
;;(define *watchdog* (make-thread
;;		    (lambda ()
;;		      (handle-exceptions

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

480
481
482
483
484
485
486









487






488
489
490
491
492
493
494
480
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







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







				(tt:start-tcp-server ttdat)) ;; start the tcp-server which applies handler to incoming data
			      "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")))
	      (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
	      (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))))))

(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