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: |
e9b993efa1861910a6d19be61c9e50ee |
| 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 | (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 | | | 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,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 | (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))) ;; 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 | > > > > > | 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 | (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) | > > > > > > > > > | > > > > > | 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
(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
|
| ︙ | ︙ |