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: |
b5f1f35f262c1301fe85564c98525572 |
| 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 |
(else
"nopurpose"))))
;; megatest process tracking
(defstruct procinf
(start (current-seconds))
(host (get-host-name)) ;; why is this not being recognised?
(pid (current-process-id))
| > | | 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 -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 |
(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
| | | > > | | | | | | 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 endtime status purpose dbname mtversion)
(sqlite3:execute
nsdb
"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 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,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,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 | "tcp-server-thread")) (run-thread (make-thread (lambda () (tt:keep-running ttdat dbfname dbstruct))))) (thread-start! tcp-thread) (thread-start! run-thread) | < > > > > > > > > > > > > > > > > > > > > < < < < < < < | | | 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)
(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*)))
(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)
|
| ︙ | ︙ |