Overview
Comment: | Lock on homehost. Servers *always* started if not on homehost |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.62-no-rpc |
Files: | files | file ages | folders |
SHA1: |
efae6c6bbf5cdc8fdd1d50acd28ae8b9 |
User & Date: | matt on 2016-11-20 20:56:22 |
Other Links: | branch diff | manifest | tags |
Context
2016-11-21
| ||
00:02 | Partial edits towards getting dashboard responding to db changes after moving to /tmp check-in: a861379b83 user: matt tags: v1.62-no-rpc | |
2016-11-20
| ||
20:56 | Lock on homehost. Servers *always* started if not on homehost check-in: efae6c6bbf user: matt tags: v1.62-no-rpc | |
2016-11-18
| ||
20:46 | Try tmp db without rpc check-in: d06a3ab427 user: matt tags: v1.62-no-rpc | |
Changes
Modified common.scm from [3a70d4042d] to [46ccba8588].
︙ | ︙ | |||
617 618 619 620 621 622 623 624 625 626 627 628 629 630 | tlist target) (if target (begin (debug:print-error 0 *default-log-port* "Invalid target, spaces or blanks not allowed \"" target "\", target should be: " (string-intersperse keys "/") ", have " tlist " for elements") #f) #f)))) ;;====================================================================== ;; M I S C L I S T S ;;====================================================================== ;; items in lista are matched value and position in listb ;; return the remaining items in listb or #f | > > > > > > > > > > > > > > > > > > > > > | 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 643 644 645 646 647 648 649 650 651 | tlist target) (if target (begin (debug:print-error 0 *default-log-port* "Invalid target, spaces or blanks not allowed \"" target "\", target should be: " (string-intersperse keys "/") ", have " tlist " for elements") #f) #f)))) ;; logic for getting homehost. Returns (host . at-home) ;; (define (common:get-homehost) (let* ((currhost (get-host-name)) (bestadrs (server:get-best-guess-address currhost)) ;; first look in config, then look in file .homehost, create it if not found (homehost (or (configf:lookup *configdat* "server" "homehost" ) (let ((hhf (conc *toppath* "/.homehost"))) (if (file-exists? hhf) (with-input-from-file hhf read-line) (if (file-write-access? *toppath*) (begin (with-output-to-file hhf (lambda () (print bestadrs))) (common:get-homehost)) #f))))) (at-home (or (equal? homehost currhost) (equal? homehost bestadrs)))) (cons homehost at-home))) ;;====================================================================== ;; M I S C L I S T S ;;====================================================================== ;; items in lista are matched value and position in listb ;; return the remaining items in listb or #f |
︙ | ︙ |
Modified rmt.scm from [51e718f694] to [eff83d134a].
︙ | ︙ | |||
34 35 36 37 38 39 40 | ;; grep define ../rmt.scm | grep rmt: |perl -pi -e 's/\(define\s+\((\S+)\W.*$/\1/'|sort -u ;;====================================================================== ;; S U P P O R T F U N C T I O N S ;;====================================================================== | < < < < < < < < < < < < < < < < < < < < < < | 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 | ;; grep define ../rmt.scm | grep rmt: |perl -pi -e 's/\(define\s+\((\S+)\W.*$/\1/'|sort -u ;;====================================================================== ;; S U P P O R T F U N C T I O N S ;;====================================================================== ;; if a server is either running or in the process of starting call client:setup ;; else return #f to let the calling proc know that there is no server available ;; (define (rmt:get-connection-info run-id) (let ((cinfo (hash-table-ref/default *runremote* run-id #f))) (if cinfo cinfo (if (tasks:server-running-or-starting? (db:delay-if-busy (tasks:open-db)) run-id) (client:setup run-id) #f)))) (define *send-receive-mutex* (make-mutex)) ;; should have separate mutex per run-id ;; RA => e.g. usage (rmt:send-receive 'get-var #f (list varname)) |
︙ | ︙ | |||
140 141 142 143 144 145 146 | ;; no connection info? try to start a server, or access locally if no ;; server and the query is read-only ;; ;; Note: The tasks db was checked for a server in starting mode in the rmt:get-connection-info call ;; (if (and (< attemptnum 15) (member cmd api:write-queries)) | | | > | | > | 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 | ;; no connection info? try to start a server, or access locally if no ;; server and the query is read-only ;; ;; Note: The tasks db was checked for a server in starting mode in the rmt:get-connection-info call ;; (if (and (< attemptnum 15) (member cmd api:write-queries)) (let ((homehost (common:get-homehost))) ;; faststart (configf:lookup *configdat* "server" "faststart"))) (hash-table-delete! *runremote* run-id) ;; (mutex-unlock! *send-receive-mutex*) (if (not (cdr homehost)) ;; we always require a server if not on homehost ;; (and faststart (equal? faststart "no")) (begin (tasks:start-and-wait-for-server (db:delay-if-busy (tasks:open-db)) run-id 10) (thread-sleep! (random 5)) ;; give some time to settle and minimize collison? (rmt:send-receive cmd rid params attemptnum: (+ attemptnum 1))) ;; NB - probably can remove the query time stuff but need to discuss it .... (let ((start-time (current-milliseconds)) (max-query (string->number (or (configf:lookup *configdat* "server" "server-query-threshold") "300"))) (newres (rmt:open-qry-close-locally cmd run-id params))) (let ((delta (- (current-milliseconds) start-time))) (if (> delta max-query) (begin (debug:print-info 0 *default-log-port* "WARNING: long query times, you may have an overloaded homehost.") ;; Starting server as query time " delta " is over the limit of " max-query) ;; (server:kind-run run-id))) )) ;; return the result! newres) ))) (begin ;; (debug:print-error 0 *default-log-port* "Communication failed!") ;; (mutex-unlock! *send-receive-mutex*) ;; (exit) |
︙ | ︙ |