Overview
| Comment: | Servers now working again |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | multi-area |
| Files: | files | file ages | folders |
| SHA1: |
3f14d7d23edc28f89d8809c88bc5dab8 |
| User & Date: | matt on 2015-04-06 01:04:48 |
| Other Links: | branch diff | manifest | tags |
Context
|
2015-04-06
| ||
| 01:09 | Servers now working again, including clean shutdown check-in: 4d4bfbb125 user: matt tags: multi-area | |
| 01:04 | Servers now working again check-in: 3f14d7d23e user: matt tags: multi-area | |
| 00:17 | More clean up check-in: 94c4b16ab4 user: matt tags: multi-area | |
Changes
Modified http-transport.scm from [e34726a39d] to [f7503f384b].
| ︙ | ︙ | |||
142 143 144 145 146 147 148 | (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 | | | | 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 |
(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
(lambda (db)
(portlogger:find-port db area-dat))
area-dat)
server-id
area-dat))
(begin
(tasks:server-force-clean-run-record (db:delay-if-busy tdbdat area-dat) 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
|
| ︙ | ︙ | |||
415 416 417 418 419 420 421 |
;; Use this opportunity to sync the inmemdb to db
(if *inmemdb*
(let ((start-time (current-milliseconds))
(sync-time #f)
(rem-time #f))
;; inmemdb is a dbstruct
(condition-case
| | | 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 |
;; Use this opportunity to sync the inmemdb to db
(if *inmemdb*
(let ((start-time (current-milliseconds))
(sync-time #f)
(rem-time #f))
;; inmemdb is a dbstruct
(condition-case
(db:sync-touched *inmemdb* area-dat *run-id* force-sync: #t)
((sync-failed)(cond
((> bad-sync-count 10) ;; time to give up
(http-transport:server-shutdown server-id port area-dat))
(else ;; (> bad-sync-count 0) ;; we've had a fail or two, delay and loop
(thread-sleep! 5)
(loop count server-state (+ bad-sync-count 1)))))
((exn)
|
| ︙ | ︙ | |||
499 500 501 502 503 504 505 |
(http-transport:server-shutdown server-id port area-dat)))))
(define (http-transport:server-shutdown server-id port area-dat)
(let ((tdbdat (tasks:open-db area-dat)))
(debug:print-info 0 "Starting to shutdown the server.")
;; need to delete only *my* server entry (future use)
(set! *time-to-exit* #t)
| | | 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 |
(http-transport:server-shutdown server-id port area-dat)))))
(define (http-transport:server-shutdown server-id port area-dat)
(let ((tdbdat (tasks:open-db area-dat)))
(debug:print-info 0 "Starting to shutdown the server.")
;; need to delete only *my* server entry (future use)
(set! *time-to-exit* #t)
(if *inmemdb* (db:sync-touched *inmemdb* area-dat *run-id* force-sync: #t))
;;
;; start_shutdown
;;
(tasks:server-set-state! (db:delay-if-busy tdbdat area-dat) server-id "shutting-down")
(portlogger:open-run-close
(lambda (db port yada)
(portlogger:set-port db area-dat port yada))
|
| ︙ | ︙ |
Modified server.scm from [e081f645f7] to [027ef0dacd].
| ︙ | ︙ | |||
235 236 237 238 239 240 241 |
(loop (read-line) inl))))))
(define (server:login toppath area-dat)
(lambda (toppath)
(set! *last-db-access* (current-seconds))
(if (equal? (megatest:area-path area-dat) toppath)
(begin
| | | | 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 |
(loop (read-line) inl))))))
(define (server:login toppath area-dat)
(lambda (toppath)
(set! *last-db-access* (current-seconds))
(if (equal? (megatest:area-path area-dat) toppath)
(begin
(debug:print-info 2 "login successful")
#t)
(begin
(debug:print-info 2 "login failed")
#f))))
(define (server:get-timeout area-dat)
(let ((tmo (configf:lookup (megatest:area-configdat area-dat) "server" "timeout")))
(if (and (string? tmo)
(string->number tmo))
(* 60 60 (string->number tmo))
|
| ︙ | ︙ |