Overview
| Comment: | Use nbfake for launching servers |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.60 |
| Files: | files | file ages | folders |
| SHA1: |
d8c9e3b4ca64e627c86970a83d7941c5 |
| User & Date: | mrwellan on 2014-09-05 11:53:41 |
| Other Links: | branch diff | manifest | tags |
Context
|
2014-09-09
| ||
| 23:06 | Tentative improvements to server starting - separate out server start from db start (dbprep). check-in: f8c63429f7 user: matt tags: v1.60 | |
|
2014-09-05
| ||
| 11:53 | Use nbfake for launching servers check-in: d8c9e3b4ca user: mrwellan tags: v1.60 | |
| 09:01 | Added some checks for when there are no tests in a regression check-in: a389004ce8 user: mrwellan tags: v1.60 | |
Changes
Modified http-transport.scm from [203243616e] to [36a92be4c5].
| ︙ | ︙ | |||
131 132 133 134 135 136 137 |
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)
| > > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | > > | | | | | 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 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 |
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)
(let ((config-hostname (configf:lookup *configdat* "server" "hostname")))
(debug:print-info 2 "http-transport:try-start-server run-id=" run-id " ipaddrsstr=" ipaddrstr " portnum=" portnum " server-id=" server-id " config-hostname=" config-hostname)
(handle-exceptions
exn
(begin
(print-error-message exn)
(if (< portnum 64000)
(begin
(debug:print 0 "WARNING: attempt to start server failed. Trying again ...")
(debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
(debug:print 0 "exn=" (condition->list exn))
(portlogger:open-run-close portlogger:set-failed portnum)
(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
(portlogger:open-run-close portlogger:find-port)
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)
(if config-hostname ;; this is a hint to bind directly
(start-server port: portnum bind-address: (if (equal? config-hostname "-")
ipaddrstr
config-hostname))
(start-server port: portnum))
;; (portlogger:open-run-close portlogger:set-port portnum "released")
(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
;;======================================================================
;;======================================================================
;; C L I E N T S
|
| ︙ | ︙ |
Modified server.scm from [11fd0dd336] to [3b1ef21982].
| ︙ | ︙ | |||
85 86 87 88 89 90 91 | (let* ((curr-host (get-host-name)) (curr-ip (server:get-best-guess-address curr-host)) (target-host (configf:lookup *configdat* "server" "homehost" )) (logfile (conc *toppath* "/logs/" run-id ".log")) (cmdln (conc (common:get-megatest-exe) " -server " (or target-host "-") " -run-id " run-id (if (equal? (configf:lookup *configdat* "server" "daemonize") "yes") (conc " -daemonize -log " logfile) | | | | | | | 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 |
(let* ((curr-host (get-host-name))
(curr-ip (server:get-best-guess-address curr-host))
(target-host (configf:lookup *configdat* "server" "homehost" ))
(logfile (conc *toppath* "/logs/" run-id ".log"))
(cmdln (conc (common:get-megatest-exe)
" -server " (or target-host "-") " -run-id " run-id (if (equal? (configf:lookup *configdat* "server" "daemonize") "yes")
(conc " -daemonize -log " logfile)
"")))) ;; (conc " >> " logfile " 2>&1 &")))))
(debug:print 0 "INFO: Starting server (" cmdln ") as none running ...")
(push-directory *toppath*)
(if (not (directory-exists? "logs"))(create-directory "logs"))
;; host.domain.tld match host?
(if (and target-host
;; look at target host, is it host.domain.tld or ip address and does it
;; match current ip or hostname
(not (string-match (conc "("curr-host "|" curr-host"\\..*)") target-host))
(not (equal? curr-ip target-host)))
(begin
(debug:print-info 0 "Starting server on " target-host ", logfile is " logfile)
(setenv "TARGETHOST" target-host)))
(setenv "TARGETHOST_LOGF" logfile)
(system (conc "nbfake " cmdln))
;; (system cmdln)
(pop-directory)))
;; kind start up of servers, wait 40 seconds before allowing another server for a given
;; run-id to be launched
(define (server:kind-run run-id)
(let ((last-run-time (hash-table-ref/default *server-kind-run* run-id #f)))
(if (or (not last-run-time)
|
| ︙ | ︙ |