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
|
(begin
(print-error-message exn)
(if (< portnum 9000)
(begin
(print "WARNING: failed to start on portnum: " portnum ", trying next port")
(thread-sleep! 0.1)
;; (open-run-close tasks:remove-server-records tasks:open-db)
(http-transport:try-start-server ipaddrstr (+ portnum 1)))
(print "ERROR: Tried and tried but could not start the server")))
(set! *runremote* (list ipaddrstr portnum))
;; (open-run-close tasks:remove-server-records tasks:open-db)
(open-run-close tasks:server-register
tasks:open-db
(current-process-id)
ipaddrstr portnum 0 'live 'http)
(print "INFO: Trying to start server on " ipaddrstr ":" portnum)
;; This starts the spiffy server
(start-server port: portnum)
(print "INFO: server has been stopped")))
;;======================================================================
;; S E R V E R U T I L I T I E S
;;======================================================================
;;======================================================================
|
>
>
>
|
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
|
(begin
(print-error-message exn)
(if (< portnum 9000)
(begin
(print "WARNING: failed to start on portnum: " portnum ", trying next port")
(thread-sleep! 0.1)
;; (open-run-close tasks:remove-server-records tasks:open-db)
(open-run-close tasks:server-delete tasks:open-db ipaddrstr portnum)
(http-transport:try-start-server ipaddrstr (+ portnum 1)))
(print "ERROR: Tried and tried but could not start the server")))
;; any error in following steps will result in a retry
(set! *runremote* (list ipaddrstr portnum))
;; (open-run-close tasks:remove-server-records tasks:open-db)
(open-run-close tasks:server-register
tasks:open-db
(current-process-id)
ipaddrstr portnum 0 'live 'http)
(print "INFO: Trying to start server on " ipaddrstr ":" portnum)
;; This starts the spiffy server
(start-server port: portnum)
(open-run-close tasks:server-delete tasks:open-db ipaddrstr portnum)
(print "INFO: server has been stopped")))
;;======================================================================
;; S E R V E R U T I L I T I E S
;;======================================================================
;;======================================================================
|
227
228
229
230
231
232
233
234
235
236
237
238
239
240
|
(thread-sleep! 4) ;; no need to do this very often
;; NB// sync currently does NOT return queue-length
(let () ;; (queue-len (cdb:client-call server-info 'sync #t 1)))
;; (print "Server running, count is " count)
(if (< count 1) ;; 3x3 = 9 secs aprox
(loop (+ count 1)))
;; NOTE: Get rid of this mechanism! It really is not needed...
(tasks:server-update-heartbeat tdb spid)
;; (if ;; (or (> numrunning 0) ;; stay alive for two days after last access
(mutex-lock! *heartbeat-mutex*)
(set! last-access *last-db-access*)
(mutex-unlock! *heartbeat-mutex*)
|
>
>
>
>
>
>
>
>
>
>
>
>
|
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
|
(thread-sleep! 4) ;; no need to do this very often
;; NB// sync currently does NOT return queue-length
(let () ;; (queue-len (cdb:client-call server-info 'sync #t 1)))
;; (print "Server running, count is " count)
(if (< count 1) ;; 3x3 = 9 secs aprox
(loop (+ count 1)))
;; Check that iface and port have not changed (can happen if server port collides)
(mutex-lock! *heartbeat-mutex*)
(set! sdat *runremote*)
(mutex-unlock! *heartbeat-mutex*)
(if (not (equal? sdat (list iface port)))
(begin
(debug:print-info 1 "interface changed, refreshing iface and port info")
(set! iface (car sdat))
(set! port (cadr sdat))
(set! spid (tasks:server-get-server-id tdb #f iface port #f))))
;; NOTE: Get rid of this mechanism! It really is not needed...
(tasks:server-update-heartbeat tdb spid)
;; (if ;; (or (> numrunning 0) ;; stay alive for two days after last access
(mutex-lock! *heartbeat-mutex*)
(set! last-access *last-db-access*)
(mutex-unlock! *heartbeat-mutex*)
|