Overview
Comment: | Bind to all interfaces on server, use client side ping in client |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.60 |
Files: | files | file ages | folders |
SHA1: |
6f7799bdbbfd6c950cb6c962d4aaa989 |
User & Date: | matt on 2014-02-27 23:45:41 |
Other Links: | branch diff | manifest | tags |
Context
2014-02-28
| ||
09:21 | server:check-if-running should use external ping check-in: f673524251 user: mrwellan tags: v1.60 | |
2014-02-27
| ||
23:45 | Bind to all interfaces on server, use client side ping in client check-in: 6f7799bdbb user: matt tags: v1.60 | |
2014-02-26
| ||
23:54 | Merged from v1.55. Included bump of IUP versions in installall.sh check-in: e97934c675 user: matt tags: v1.60 | |
Changes
Modified client.scm from [ac9cc63d23] to [d348228595].
︙ | ︙ | |||
62 63 64 65 66 67 68 | (debug:print 0 "ERROR: failed to start or connect to server for run-id " run-id) (exit 1)) (let ((host-info (hash-table-ref/default *runremote* run-id #f))) (if host-info (let* ((iface (car host-info)) (port (cadr host-info)) (start-res (http-transport:client-connect iface port)) | | > | 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 | (debug:print 0 "ERROR: failed to start or connect to server for run-id " run-id) (exit 1)) (let ((host-info (hash-table-ref/default *runremote* run-id #f))) (if host-info (let* ((iface (car host-info)) (port (cadr host-info)) (start-res (http-transport:client-connect iface port)) ;; (ping-res (server:ping-server run-id iface port)) (ping-res (rmt:login-no-auto-client-setup server-dat run-id))) (if ping-res ;; sucessful login? (begin (hash-table-set! *runremote* run-id start-res) start-res) ;; return the server info (if (member remaining-tries '(3 4 6)) (begin ;; login failed (debug:print 25 "INFO: client:setup start-res=" start-res ", run-id=" run-id ", server-dat=" host-info) |
︙ | ︙ | |||
89 90 91 92 93 94 95 | (client:setup run-id remaining-tries: (- remaining-tries 1)))))) ;; YUK: rename server-dat here (let* ((server-dat (open-run-close tasks:get-server tasks:open-db run-id))) (if server-dat (let* ((iface (tasks:hostinfo-get-interface server-dat)) (port (tasks:hostinfo-get-port server-dat)) (start-res (http-transport:client-connect iface port)) | | > | 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 | (client:setup run-id remaining-tries: (- remaining-tries 1)))))) ;; YUK: rename server-dat here (let* ((server-dat (open-run-close tasks:get-server tasks:open-db run-id))) (if server-dat (let* ((iface (tasks:hostinfo-get-interface server-dat)) (port (tasks:hostinfo-get-port server-dat)) (start-res (http-transport:client-connect iface port)) ;; (ping-res (server:ping-server run-id iface port)) (ping-res (rmt:login-no-auto-client-setup start-res run-id))) (if start-res (begin (hash-table-set! *runremote* run-id start-res) start-res) (if (member remaining-tries '(2 5)) (begin ;; login failed (debug:print 25 "INFO: client:setup start-res=" start-res ", run-id=" run-id ", server-dat=" server-dat) |
︙ | ︙ |
Modified http-transport.scm from [73e18fc9d1] to [ddcbd18141].
︙ | ︙ | |||
66 67 68 69 70 71 72 | (hostname (get-host-name)) (ipaddrstr (let ((ipstr (if (string=? "-" hostn) ;; (string-intersperse (map number->string (u8vector->list (hostname->ip hostname))) ".") (server:get-best-guess-address hostname) #f))) (if ipstr ipstr hostn))) ;; hostname))) (start-port (open-run-close tasks:server-get-next-port tasks:open-db)) | | | 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 | (hostname (get-host-name)) (ipaddrstr (let ((ipstr (if (string=? "-" hostn) ;; (string-intersperse (map number->string (u8vector->list (hostname->ip hostname))) ".") (server:get-best-guess-address hostname) #f))) (if ipstr ipstr hostn))) ;; hostname))) (start-port (open-run-close tasks:server-get-next-port tasks:open-db)) (link-tree-path (configf:lookup *configdat* "setup" "linktree"))) (set! db *inmemdb*) (root-path (if link-tree-path link-tree-path (current-directory))) ;; WARNING: SECURITY HOLE. FIX ASAP! (handle-directory spiffy-directory-listing) ;; http-transport:handle-directory) ;; simple-directory-handler) ;; Setup the web server and a /ctrl interface |
︙ | ︙ | |||
125 126 127 128 129 130 131 | (send-response body: "hey there!\n" headers: '((content-type text/plain)))) ((equal? (uri-path (request-uri (current-request))) '(/ "hey")) (send-response body: "hey there!\n" headers: '((content-type text/plain)))) (else (continue)))))))) | | | | | > | 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 169 | (send-response body: "hey there!\n" headers: '((content-type text/plain)))) ((equal? (uri-path (request-uri (current-request))) '(/ "hey")) (send-response body: "hey there!\n" headers: '((content-type text/plain)))) (else (continue)))))))) (http-transport:try-start-server run-id ipaddrstr start-port server-id))) ;; This is recursively run by http-transport:run until sucessful ;; (define (http-transport:try-start-server run-id ipaddrstr portnum server-id) (handle-exceptions exn (begin (print-error-message exn) (if (< portnum 9000) (begin (debug:print 0 "WARNING: failed to start on portnum: " portnum ", trying next port") (thread-sleep! 0.1) ;; get_next_port goes here (http-transport:try-start-server run-id ipaddrstr (+ portnum 1) server-id)) (begin (open-run-close tasks:server-force-clean-run-record tasks:open-db run-id ipaddrstr portnum " http-transport:try-start-server") (print "ERROR: Tried and tried but could not start the server")))) ;; any error in following steps will result in a retry (set! *server-info* (list ipaddrstr portnum)) (open-run-close tasks:server-set-interface-port tasks:open-db server-id ipaddrstr portnum) (debug:print 1 "INFO: Trying to start server on " ipaddrstr ":" portnum) ;; This starts the spiffy server ;; NEED WAY TO SET IP TO #f TO BIND ALL (start-server ;; bind-address: ipaddrstr port: portnum) (open-run-close tasks:server-force-clean-run-record tasks:open-db run-id ipaddrstr portnum " http-transport:try-start-server") (debug:print 1 "INFO: server has been stopped"))) ;;====================================================================== ;; S E R V E R U T I L I T I E S ;;====================================================================== |
︙ | ︙ | |||
266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 | res))))) ;; ;; connect ;; (define (http-transport:client-connect iface port) (let* ((uri-dat (make-request method: 'POST uri: (uri-reference (conc "http://" iface ":" port "/ctrl")))) (uri-api-dat (make-request method: 'POST uri: (uri-reference (conc "http://" iface ":" port "/api")))) (server-dat (list iface port uri-dat uri-api-dat))) ;; (login-res (server:ping-server run-id server-dat))) ;; login-no-auto-client-setup server-dat run-id))) server-dat)) ;; (if (and (list? login-res) ;; (car login-res)) ;; (begin ;; (hash-table-set! *runremote* run-id server-dat) | > > | 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 | res))))) ;; ;; connect ;; (define (http-transport:client-connect iface port) (let* ((uri-dat (make-request method: 'POST uri: (uri-reference (conc "http://" iface ":" port "/ctrl")))) ;; (uri-dat (make-request method: 'GET uri: (uri-reference (conc "http://" iface ":" port "/ctrl")))) (uri-api-dat (make-request method: 'POST uri: (uri-reference (conc "http://" iface ":" port "/api")))) ;; (uri-api-dat (make-request method: 'GET uri: (uri-reference (conc "http://" iface ":" port "/api")))) (server-dat (list iface port uri-dat uri-api-dat))) ;; (login-res (server:ping-server run-id server-dat))) ;; login-no-auto-client-setup server-dat run-id))) server-dat)) ;; (if (and (list? login-res) ;; (car login-res)) ;; (begin ;; (hash-table-set! *runremote* run-id server-dat) |
︙ | ︙ | |||
308 309 310 311 312 313 314 | (loop start-time (equal? sdat last-sdat) sdat)))))) (iface (car server-info)) (port (cadr server-info)) (last-access 0) (tdb (tasks:open-db)) | | | 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 | (loop start-time (equal? sdat last-sdat) sdat)))))) (iface (car server-info)) (port (cadr server-info)) (last-access 0) (tdb (tasks:open-db)) (server-timeout (let ((tmo (configf:lookup *configdat* "server" "timeout"))) (if (and (string? tmo) (string->number tmo)) (* 60 60 (string->number tmo)) ;; (* 3 24 60 60) ;; default to three days ;; (* 60 1) ;; default to one minute (* 60 60 25) ;; default to 25 hours )))) |
︙ | ︙ |