Overview
Comment: | server fixes |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.62-no-rpc |
Files: | files | file ages | folders |
SHA1: |
f0c98a8cd88ffbee8d932b240b8c23c1 |
User & Date: | mrwellan on 2016-12-01 15:58:47 |
Other Links: | branch diff | manifest | tags |
Context
2016-12-01
| ||
16:17 | server fixes check-in: dee83609d2 user: mrwellan tags: v1.62-no-rpc | |
15:58 | server fixes check-in: f0c98a8cd8 user: mrwellan tags: v1.62-no-rpc | |
08:43 | Cleaned up server starting. Should be no run-away starting of too many servers now. check-in: dc09eb179b user: mrwellan tags: v1.62-no-rpc | |
Changes
Modified client.scm from [5c6ba40366] to [50265f350f].
︙ | ︙ | |||
168 169 170 171 172 173 174 | (hostname (tasks:hostinfo-get-hostname server-dat)) (port (tasks:hostinfo-get-port server-dat)) (start-res (case *transport-type* ((http)(http-transport:client-connect iface port)) ;;((nmsg)(nmsg-transport:client-connect hostname port)) )) (ping-res (case *transport-type* | | | | | | 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 | (hostname (tasks:hostinfo-get-hostname server-dat)) (port (tasks:hostinfo-get-port server-dat)) (start-res (case *transport-type* ((http)(http-transport:client-connect iface port)) ;;((nmsg)(nmsg-transport:client-connect hostname port)) )) (ping-res (case *transport-type* ((http)(rmt:login-no-auto-client-setup start-res)) ;; ((nmsg)(let ((logininfo (rmt:login-no-auto-client-setup start-res run-id))) ;; (if logininfo ;; (car (vector-ref logininfo 1)) ;; #f))) ))) (if (and start-res ping-res) (begin (remote-conndat-set! *runremote* start-res) ;; (hash-table-set! *runremote* run-id start-res) (debug:print-info 2 *default-log-port* "connected to " (http-transport:server-dat-make-url start-res)) start-res) (begin ;; login failed but have a server record, clean out the record and try again (debug:print-info 0 *default-log-port* "client:setup, login failed, will attempt to start server ... start-res=" start-res ", run-id=" run-id ", server-dat=" server-dat) (case *transport-type* ((http)(http-transport:close-connections run-id))) (remote-conndat-set! *runremote* #f) ;; (hash-table-delete! *runremote* run-id) (tasks:kill-server-run-id run-id) (tasks:server-force-clean-run-record (db:delay-if-busy tdbdat) run-id (tasks:hostinfo-get-interface server-dat) (tasks:hostinfo-get-port server-dat) " client:setup (server-dat = #t)") (if (> remaining-tries 8) |
︙ | ︙ |
Modified http-transport.scm from [a93ed3a08e] to [e3c099e72f].
︙ | ︙ | |||
24 25 26 27 28 29 30 31 32 33 34 35 36 37 | (declare (uses common)) (declare (uses db)) (declare (uses tests)) (declare (uses tasks)) ;; tasks are where stuff is maintained about what is running. (declare (uses server)) (declare (uses daemon)) (declare (uses portlogger)) (include "common_records.scm") (include "db_records.scm") (define (http-transport:make-server-url hostport) (if (not hostport) #f | > | 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 | (declare (uses common)) (declare (uses db)) (declare (uses tests)) (declare (uses tasks)) ;; tasks are where stuff is maintained about what is running. (declare (uses server)) (declare (uses daemon)) (declare (uses portlogger)) (declare (uses rmt)) (include "common_records.scm") (include "db_records.scm") (define (http-transport:make-server-url hostport) (if (not hostport) #f |
︙ | ︙ | |||
217 218 219 220 221 222 223 | (http-transport:server-dat-get-api-req serverdat) (begin (debug:print 0 *default-log-port* "FATAL ERROR: http-transport:client-api-send-receive called with no server info") (exit 1)))) (res #f) (success #t) (sparams (db:obj->string params transport: 'http))) | < < < < < < < < < < < < < < < < < < | 218 219 220 221 222 223 224 225 226 227 228 229 230 231 | (http-transport:server-dat-get-api-req serverdat) (begin (debug:print 0 *default-log-port* "FATAL ERROR: http-transport:client-api-send-receive called with no server info") (exit 1)))) (res #f) (success #t) (sparams (db:obj->string params transport: 'http))) (debug:print-info 11 *default-log-port* "fullurl=" fullurl ", cmd=" cmd ", params=" params ", run-id=" run-id "\n") ;; set up the http-client here (max-retry-attempts 1) ;; consider all requests indempotent (retry-request? (lambda (request) #f)) ;; send the data and get the response |
︙ | ︙ | |||
257 258 259 260 261 262 263 | (db:string->obj (handle-exceptions exn (begin (set! success #f) (debug:print 0 *default-log-port* "WARNING: failure in with-input-from-request to " fullurl ".") (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn)) | > | | 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 | (db:string->obj (handle-exceptions exn (begin (set! success #f) (debug:print 0 *default-log-port* "WARNING: failure in with-input-from-request to " fullurl ".") (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn)) (if *runremote* (remote-conndat-set! *runremote* #f)) ;; Killing associated server to allow clean retry.") ;; (tasks:kill-server-run-id run-id) ;; better to kill the server in the logic that called this routine? (mutex-unlock! *http-mutex*) ;;; (signal (make-composite-condition ;;; (make-property-condition 'commfail 'message "failed to connect to server"))) ;;; "communications failed" (db:obj->string #f)) |
︙ | ︙ | |||
304 305 306 307 308 309 310 | (make-property-condition 'timeout 'message "nmsg-transport:client-api-send-receive-raw timed out talking to server"))))))) ;; careful closing of connections stored in *runremote* ;; (define (http-transport:close-connections run-id) | > > | | 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 | (make-property-condition 'timeout 'message "nmsg-transport:client-api-send-receive-raw timed out talking to server"))))))) ;; careful closing of connections stored in *runremote* ;; (define (http-transport:close-connections run-id) (let* ((server-dat (if *runremote* (remote-conndat *runremote*) #f))) ;; (hash-table-ref/default *runremote* run-id #f))) (if (vector? server-dat) (let ((api-dat (http-transport:server-dat-get-api-uri server-dat))) (close-connection! api-dat) #t) #f))) |
︙ | ︙ |
Modified megatest.scm from [60075c013d] to [0f68bdb0a0].
︙ | ︙ | |||
1861 1862 1863 1864 1865 1866 1867 | ;; fakeout readline (include "readline-fix.scm") (if (or (getenv "MT_RUNSCRIPT") (args:get-arg "-repl") (args:get-arg "-load")) (let* ((toppath (launch:setup)) | > > > | | | 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 | ;; fakeout readline (include "readline-fix.scm") (if (or (getenv "MT_RUNSCRIPT") (args:get-arg "-repl") (args:get-arg "-load")) (let* ((toppath (launch:setup)) (dbstruct (if (and toppath (common:on-homehost?)) (db:setup) #f))) ;; make-dbr:dbstruct path: toppath local: (args:get-arg "-local")) #f))) (if *toppath* (cond ((getenv "MT_RUNSCRIPT") ;; How to run megatest scripts ;; ;; #!/bin/bash ;; ;; export MT_RUNSCRIPT=yes |
︙ | ︙ |
Modified rmt.scm from [8fc869d3b5] to [2f3003ec4b].
︙ | ︙ | |||
38 39 40 41 42 43 44 | ;; 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) | | < < < < < | 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 | ;; 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 (remote-conndat *runremote*))) (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 |
︙ | ︙ | |||
73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 | ((> attemptnum 15) (debug:print 0 *default-log-port* "ERROR: 15 tries to start/connect to server. Giving up.") (exit 1)) ;; ensure we have a record for our connection for given area ((not *runremote*) (set! *runremote* (make-remote)) (mutex-unlock! *rmt-mutex*) (rmt:send-receive cmd rid params attemptnum: attemptnum)) ;; ensure we have a homehost record ((not (pair? (remote-hh-dat *runremote*))) ;; have a homehost record? (thread-sleep! 0.1) ;; since we shouldn't get here, delay a little (remote-hh-dat-set! *runremote* (common:get-homehost)) (mutex-unlock! *rmt-mutex*) (rmt:send-receive cmd rid params attemptnum: attemptnum)) ;; on homehost and this is a read ((and (cdr (remote-hh-dat *runremote*)) ;; on homehost (member cmd api:read-only-queries)) ;; this is a read (mutex-unlock! *rmt-mutex*) (rmt:open-qry-close-locally cmd 0 params)) ;; on homehost and this is a write, we already have a server ((and (cdr (remote-hh-dat *runremote*)) ;; on homehost (not (member cmd api:read-only-queries)) ;; this is a write (remote-server-url *runremote*)) ;; have a server (mutex-unlock! *rmt-mutex*) (rmt:open-qry-close-locally cmd 0 params)) | > > > > | > | | | | < | > > | > | > | | | | > > | | | > | 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 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 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 | ((> attemptnum 15) (debug:print 0 *default-log-port* "ERROR: 15 tries to start/connect to server. Giving up.") (exit 1)) ;; ensure we have a record for our connection for given area ((not *runremote*) (set! *runremote* (make-remote)) (mutex-unlock! *rmt-mutex*) ;; (print "case 1") (rmt:send-receive cmd rid params attemptnum: attemptnum)) ;; ensure we have a homehost record ((not (pair? (remote-hh-dat *runremote*))) ;; have a homehost record? (thread-sleep! 0.1) ;; since we shouldn't get here, delay a little (remote-hh-dat-set! *runremote* (common:get-homehost)) (mutex-unlock! *rmt-mutex*) ;; (print "case 2") (rmt:send-receive cmd rid params attemptnum: attemptnum)) ;; on homehost and this is a read ((and (cdr (remote-hh-dat *runremote*)) ;; on homehost (member cmd api:read-only-queries)) ;; this is a read (mutex-unlock! *rmt-mutex*) ;; (print "case 3") (rmt:open-qry-close-locally cmd 0 params)) ;; on homehost and this is a write, we already have a server ((and (cdr (remote-hh-dat *runremote*)) ;; on homehost (not (member cmd api:read-only-queries)) ;; this is a write (remote-server-url *runremote*)) ;; have a server (mutex-unlock! *rmt-mutex*) ;; (print "case 4") (rmt:open-qry-close-locally cmd 0 params)) ;; no server contact made and this is a write, passively start a server ((and (not (remote-server-url *runremote*)) (not (member cmd api:read-only-queries))) ;; (print "case 5") (let ((serverconn (server:check-if-running *toppath*))) (if serverconn (remote-server-url-set! *runremote* serverconn) ;; the string can be consumed by the client setup if needed (if (not (server:start-attempted? *toppath*)) (server:kind-run *toppath*)))) (if (cdr (remote-hh-dat *runremote*)) ;; we are on the homehost, just do the call (begin (mutex-unlock! *rmt-mutex*) (rmt:open-qry-close-locally cmd 0 params)) (begin (mutex-unlock! *rmt-mutex*) (rmt:send-receive cmd rid params attemptnum: attemptnum)))) ;; if not on homehost ensure we have a connection to a live server ;; NOTE: we *have* a homehost record by now ((and (not (cdr (remote-hh-dat *runremote*))) ;; are we on a homehost? (not (remote-conndat *runremote*))) ;; and no connection ;; (print "case 6 hh-dat: " (remote-hh-dat *runremote*) " conndat: " (remote-conndat *runremote*)) (mutex-unlock! *rmt-mutex*) (tasks:start-and-wait-for-server (tasks:open-db) 0 15) (remote-conndat-set! *runremote* (rmt:get-connection-info 0)) (rmt:send-receive cmd rid params attemptnum: attemptnum)) ;; all set up if get this far, dispatch the query ((cdr (remote-hh-dat *runremote*)) ;; we are on homehost (mutex-unlock! *rmt-mutex*) ;; (print "case 7") (rmt:open-qry-close-locally cmd (if rid rid 0) params)) ;; reset the connection if it has been unused too long ((and (remote-conndat *runremote*) (let ((expire-time (- start-time (remote-server-timeout *runremote*)))) (< (http-transport:server-dat-get-last-access (remote-conndat *runremote*)) expire-time))) ;; (print "case 8") (remote-conndat-set! *runremote* #f)) ;; not on homehost, do server query (else (mutex-unlock! *rmt-mutex*) ;; (print "case 9") (let* ((conninfo (remote-conndat *runremote*)) (dat (case (remote-transport *runremote*) ((http) ;; (condition-case ;; handling here has caused a lot of problems. (http-transport:client-api-send-receive 0 conninfo cmd params) ;; ((commfail)(vector #f "communications fail")) ;; ((exn)(vector #f "other fail" (print-call-chain))))) ) (else (debug:print 0 *default-log-port* "ERROR: transport " (remote-transport *runremote*) " not supported") (exit)))) (success (if (vector? dat) (vector-ref dat 0) #f)) (res (if (vector? dat) (vector-ref dat 1) #f))) (if (vector? conninfo)(http-transport:server-dat-update-last-access conninfo)) ;; refresh access time ;; (print "case 9. conninfo=" conninfo " dat=" dat) (if success (case (remote-transport *runremote*) ((http) res) (else (debug:print 0 *default-log-port* "ERROR: transport " (remote-transport *runremote*) " is unknown") (exit 1))) (begin (debug:print 0 *default-log-port* "WARNING: communication failed. Trying again, try num: " attemptnum) (remote-conndat-set! *runremote* #f) (remote-server-url-set! *runremote* #f) ;; (print "case 9.1") (tasks:start-and-wait-for-server (tasks:open-db) 0 15) (rmt:send-receive cmd rid params attemptnum: (+ attemptnum 1))))))))) (define (rmt:update-db-stats run-id rawcmd params duration) (mutex-lock! *db-stats-mutex*) (handle-exceptions exn |
︙ | ︙ | |||
244 245 246 247 248 249 250 | (mutex-lock! *db-multi-sync-mutex*) (set! *db-last-write* start-time) ;; the oldest "write" (mutex-unlock! *db-multi-sync-mutex*))))) res)) (define (rmt:send-receive-no-auto-client-setup connection-info cmd run-id params) (let* ((run-id (if run-id run-id 0)) | < < < < < < | 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 | (mutex-lock! *db-multi-sync-mutex*) (set! *db-last-write* start-time) ;; the oldest "write" (mutex-unlock! *db-multi-sync-mutex*))))) res)) (define (rmt:send-receive-no-auto-client-setup connection-info cmd run-id params) (let* ((run-id (if run-id run-id 0)) (res (handle-exceptions exn #f (http-transport:client-api-send-receive run-id connection-info cmd params)))) (if (and res (vector-ref res 0)) (vector-ref res 1) ;;; YES!! THIS IS CORRECT!! CHANGE IT HERE, THEN CHANGE rmt:send-receive ALSO!!! #f))) ;; ;; Wrap json library for strings (why the ports crap in the first place?) ;; (define (rmt:dat->json-str dat) ;; (with-output-to-string ;; (lambda () ;; (json-write dat)))) ;; |
︙ | ︙ |