Overview
| Comment: | Exit server if not in running within 30 seconds |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.80-revolution | v1.8022 |
| Files: | files | file ages | folders |
| SHA1: |
cdd1ad3a9222eab1256c908d8c971ae6 |
| User & Date: | mrwellan on 2023-11-28 08:53:14 |
| Other Links: | branch diff | manifest | tags |
Context
|
2023-11-28
| ||
| 13:45 | Bypass all the mutexes in dashboard. It seems to help with performance quite a bit. check-in: f4844a3801 user: mrwellan tags: v1.80-revolution, v1.8022 | |
| 08:53 | Exit server if not in running within 30 seconds check-in: cdd1ad3a92 user: mrwellan tags: v1.80-revolution, v1.8022 | |
|
2023-11-27
| ||
| 19:37 | Bumped version to v1.8021 check-in: 7e1fb429aa user: mrwellan tags: v1.80-revolution, v1.8021 | |
Changes
Modified megatest-version.scm from [4f83d1d6bd] to [db025c31f0].
| ︙ | ︙ | |||
16 17 18 19 20 21 22 | ;; along with Megatest. If not, see <http://www.gnu.org/licenses/>. ;; Always use two or four digit decimal ;; 1.01, 1.02...1.10,1.11,1.1101 ... 1.99,2.00.. ;; (declare (unit megatest-version)) | | | 16 17 18 19 20 21 22 23 | ;; along with Megatest. If not, see <http://www.gnu.org/licenses/>. ;; Always use two or four digit decimal ;; 1.01, 1.02...1.10,1.11,1.1101 ... 1.99,2.00.. ;; (declare (unit megatest-version)) (define megatest-version 1.8022) |
Modified tcp-transportmod.scm from [2aca24dc6e] to [fb9929d164].
| ︙ | ︙ | |||
581 582 583 584 585 586 587 | (define (tt:keep-running ttdat dbfname dbstruct) ;; at this point the server is running and responding to calls, we just monitor ;; for db calls and exit if there are none. ;; if I am not in the first 3 servers, exit | | | | | | | | | | | | | | | | | | | | | > > > > | | | | | | 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 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 |
(define (tt:keep-running ttdat dbfname dbstruct)
;; at this point the server is running and responding to calls, we just monitor
;; for db calls and exit if there are none.
;; if I am not in the first 3 servers, exit
(let* ((start-time (current-seconds)))
(let loop ()
(let* ((servers (tt:get-server-info-sorted ttdat dbfname))
(home-host (if (null? servers)
#f
(caar servers)))
(my-index (list-index (lambda (x)
(equal? (list-ref x 6)
(tt-servinf-file ttdat)))
servers))
(ok (cond
((not *server-run*)
(debug:print 0 *default-log-port* "WARNING: received a stop server from client by remote request.")
#f)
((null? servers)
(debug:print 0 *default-log-port* "WARNING: no servinfo files found, this cannot be.")
#f) ;; not ok
((> my-index 2)
(debug:print 0 *default-log-port* "WARNING: there are more than two servers ahead of me, I'm not needed, exiting.")
#f) ;; not ok to not be in first three
((eq? (tt-state ttdat) 'running) #t) ;; we are good to keep going
((> (- (current-seconds) start-time) 30)
(debug:print 0 *default-log-port* "WARNING: over 30 seconds and not yet in runnning mode. Exiting.")
#f)
(else #t))))
(if ok
(tt-last-access-set! ttdat *db-last-access*) ;; bit silly, just use db-last-access
(begin
(debug:print 0 *default-log-port* "Exiting immediately")
(tt:shutdown-server ttdat)
(exit)))
(let* ((last-update (dbr:dbstruct-last-update dbstruct))
(curr-secs (current-seconds)))
(if (and (eq? (tt-state ttdat) 'running)
(> (- curr-secs last-update) 5)) ;; every 5 seconds update the db?
(let* ((sinfo-file (tt-servinf-file ttdat)))
;; (debug:print 0 *default-log-port* "INFO: touching "sinfo-file)
(set! (file-modification-time sinfo-file) (current-seconds))
((dbr:dbstruct-sync-proc dbstruct) last-update)
(dbr:dbstruct-last-update-set! dbstruct curr-secs))))
(if (< (- (current-seconds) (tt-last-access ttdat)) (tt-server-timeout-param))
(begin
(thread-sleep! 5)
(loop)))))
;; (cleanup) ;; all done by tt:shutdown-server
(debug:print 0 *default-log-port* "INFO: Server timed out, exiting from tt:keep-running.")))
(define (tt:shutdown-server ttdat)
(let* ((host (tt-host ttdat))
(port (tt-port ttdat))
(sinf (tt-servinf-file ttdat)))
(tt-state-set! ttdat 'shutdown)
|
| ︙ | ︙ |