Overview
Comment: | wip |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.6584-ck5 |
Files: | files | file ages | folders |
SHA1: |
f3260cf6bc2dd0dd85b184593e9f7912 |
User & Date: | matt on 2021-04-29 21:58:25 |
Other Links: | branch diff | manifest | tags |
Context
2021-04-29
| ||
22:37 | basics for main.db working check-in: a80b708d01 user: matt tags: v1.6584-ck5 | |
21:58 | wip check-in: f3260cf6bc user: matt tags: v1.6584-ck5 | |
09:17 | locking of main.db nearly complete check-in: 336e9917b1 user: matt tags: v1.6584-ck5 | |
Changes
Modified dbmod.scm from [2abeb8436f] to [21e8eceb8c].
︙ | ︙ | |||
239 240 241 242 243 244 245 246 247 248 249 250 251 252 | ;;====================================================================== ;; setting/getting a lock on the db for only one server per db ;; ;; NOTE: ;; These operate directly on the disk file, NOT on the inmemory db ;; The lockname is the filename (can have many to one, run-id to fname ;;====================================================================== ;; called before db is open? ;; (define (db:get-iam-server-lock dbh dbfname) (sqlite3:with-transaction dbh (lambda () | > > > > > > | | > | < | 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 | ;;====================================================================== ;; setting/getting a lock on the db for only one server per db ;; ;; NOTE: ;; These operate directly on the disk file, NOT on the inmemory db ;; The lockname is the filename (can have many to one, run-id to fname ;;====================================================================== (define (with-lock-db dbfile proc) (let* ((dbh (db:open-run-db dbfile db:initialize-db)) (res (proc dbh dbfile))) (sqlite3:finalize! dbh) res)) ;; called before db is open? ;; (define (db:get-iam-server-lock dbh dbfname) (sqlite3:with-transaction dbh (lambda () (let* ((locker (db:get-locker dbh dbfname))) (if locker #f (db:take-lock dbh dbfname)))))) ;; (exn sqlite3) (define (db:get-locker dbh dbfname) (condition-case (sqlite3:first-row dbh "SELECT owner_pid,owner_host,event_time FROM locks WHERE lockname=%;" dbfname) (exn (sqlite3) #f))) |
︙ | ︙ |
Modified http-transportmod.scm from [51f05a712a] to [ce6e1560b9].
︙ | ︙ | |||
97 98 99 100 101 102 103 | ;; Configurations for server (tcp-buffer-size 2048) (max-connections 2048) (defstruct servdat host port | | > > | 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 | ;; Configurations for server (tcp-buffer-size 2048) (max-connections 2048) (defstruct servdat host port uuid dbfile ) (define (http-transport:make-server-url hostport) (if (not hostport) #f (conc "http://" (car hostport) ":" (cadr hostport)))) ;;====================================================================== |
︙ | ︙ | |||
448 449 450 451 452 453 454 | ;;====================================================================== ;; NEW SERVER METHOD ;;====================================================================== ;; only use for main.db - need to re-write some of this :( ;; | | < | 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 | ;;====================================================================== ;; NEW SERVER METHOD ;;====================================================================== ;; only use for main.db - need to re-write some of this :( ;; (define (get-lock-db dbfile) (let* ((dbh (db:open-run-db dbfile db:initialize-db)) (res (db:get-iam-server-lock dbh dbfile))) (sqlite3:finalize! dbh) res)) (define *srvpktspec* `((server (host . h) (port . p) (servkey . k) (pid . i) (ipaddr . a) |
︙ | ︙ | |||
629 630 631 632 633 634 635 | (let* ((all-pkts (get-all-server-pkts pkts-dir *srvpktspec*)) (viables (get-viable-servers all-pkts db-file)) (best-srv (get-best-candidate viables db-file)) (best-srv-key (if best-srv (alist-ref 'servkey best-srv) #f))) (debug:print 0 *default-log-port* "best-srv-key: "best-srv-key", server-key: "server-key) ;; am I the best-srv, compare server-keys to know (if (equal? best-srv-key server-key) | | > | > > | > | > > | 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 | (let* ((all-pkts (get-all-server-pkts pkts-dir *srvpktspec*)) (viables (get-viable-servers all-pkts db-file)) (best-srv (get-best-candidate viables db-file)) (best-srv-key (if best-srv (alist-ref 'servkey best-srv) #f))) (debug:print 0 *default-log-port* "best-srv-key: "best-srv-key", server-key: "server-key) ;; am I the best-srv, compare server-keys to know (if (equal? best-srv-key server-key) (if (get-lock-db db-file) ;; (db:get-iam-server-lock *dbstruct-db* *toppath* run-id) (begin (debug:print 0 *default-log-port* "I'm the server!") (servdat-dbfile-set! sdat db-file)) (begin (debug:print 0 *default-log-port* "I'm not the server, exiting.") (bdat-time-to-exit-set! *bdat* #t) (thread-sleep! 0.2) (exit))) (begin (debug:print 0 *default-log-port* "Keys do not match "best-srv-key", "server-key", exiting.") (bdat-time-to-exit-set! *bdat* #t) (thread-sleep! 0.2) (exit))) sdat)) (begin (debug:print-info 0 *default-log-port* "Still waiting, last-sdat=" last-sdat) (sleep 4) (if (> (- (current-seconds) start-time) 120) ;; been waiting for two minutes (begin (debug:print-error 0 *default-log-port* "transport appears to have died, exiting server") |
︙ | ︙ |
Modified rmtmod.scm from [9c11844c69] to [b48d720a5c].
︙ | ︙ | |||
58 59 60 61 62 63 64 65 66 67 68 69 70 71 | srfi-18 srfi-69 commonmod apimod itemsmod debugprint mtver tasksmod pgdb (prefix mtargs args:) dbmod http-transportmod servermod clientmod | > | 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 | srfi-18 srfi-69 commonmod apimod itemsmod debugprint mtver regex tasksmod pgdb (prefix mtargs args:) dbmod http-transportmod servermod clientmod |
︙ | ︙ | |||
1768 1769 1770 1771 1772 1773 1774 | (if (and no-hurry (debug:debug-mode 18)) (rmt:print-db-stats)) (let ((th1 (make-thread (lambda () ;; thread for cleaning up, give it five seconds (if *dbstruct-db* (db:close-all *dbstruct-db*)) ;; one second allocated (if *server-info* (let ((pkt-file (conc (get-pkts-dir *toppath*) "/" (servdat-uuid *server-info*) | | > | > > > > > > > | < < < < < | 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 | (if (and no-hurry (debug:debug-mode 18)) (rmt:print-db-stats)) (let ((th1 (make-thread (lambda () ;; thread for cleaning up, give it five seconds (if *dbstruct-db* (db:close-all *dbstruct-db*)) ;; one second allocated (if *server-info* (let ((pkt-file (conc (get-pkts-dir *toppath*) "/" (servdat-uuid *server-info*) ".pkt")) (dbfile (servdat-dbfile *server-info*))) (debug:print-info 0 *default-log-port* "removing pkt "pkt-file) (delete-file* pkt-file) (if (and dbfile (string-match ".*/main.db$" dbfile)) (begin (debug:print-info 0 *default-log-port* "Releasing lock for "dbfile) (with-lock-db (servdat-dbfile *server-info*) (lambda (dbh dbfile) (db:release-lock dbh))))))) (if (bdat-task-db *bdat*) ;; TODO: Check that this is correct for task db (let ((db (cdr (bdat-task-db *bdat*)))) (if (sqlite3:database? db) (begin (sqlite3:interrupt! db) (sqlite3:finalize! db #t) (bdat-task-db-set! *bdat* #f))))) (http-client#close-idle-connections!) (if (not (eq? *default-log-port* (current-error-port))) (close-output-port *default-log-port*)) (set! *default-log-port* (current-error-port))) "Cleanup db exit thread")) (th2 (make-thread (lambda () (debug:print 4 *default-log-port* "Attempting clean exit. Please be patient and wait a few seconds...") (if no-hurry (begin |
︙ | ︙ |