Overview
| Comment: | wip |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | v1.63-tdb-dotserver-refactor |
| Files: | files | file ages | folders |
| SHA1: |
5cb3a069f8e032fd54407a3db3c2f25c |
| User & Date: | bjbarcla on 2017-01-03 16:07:22 |
| Other Links: | branch diff | manifest | tags |
Context
|
2017-01-03
| ||
| 16:07 | wip Closed-Leaf check-in: 5cb3a069f8 user: bjbarcla tags: v1.63-tdb-dotserver-refactor | |
| 14:08 | wip check-in: e617679e45 user: bjbarcla tags: v1.63-tdb-dotserver-refactor | |
Changes
Modified http-transport.scm from [7e12c76127] to [e1abcb3338].
| ︙ | ︙ | |||
397 398 399 400 401 402 403 |
(tasks:server-set-state! (db:delay-if-busy tdbdat) server-id "dbprep")
;;(BB> "http-transport: ->dbprep")
(thread-sleep! 0.5) ;; give some margin for queries to complete before switching from file based access to server based access
(set! *dbstruct-db* (db:setup)) ;; run-id))
(set! server-going #t)
(tasks:server-set-state! (db:delay-if-busy tdbdat) server-id "running")
;;(BB> "http-transport: ->running")
| | | | 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 |
(tasks:server-set-state! (db:delay-if-busy tdbdat) server-id "dbprep")
;;(BB> "http-transport: ->dbprep")
(thread-sleep! 0.5) ;; give some margin for queries to complete before switching from file based access to server based access
(set! *dbstruct-db* (db:setup)) ;; run-id))
(set! server-going #t)
(tasks:server-set-state! (db:delay-if-busy tdbdat) server-id "running")
;;(BB> "http-transport: ->running")
(server:write-dotserver *toppath* iface port (current-process-id) 'http) ;; create file .server
(thread-start! *watchdog*)
(server:complete-attempt *toppath*)) ;; delete file .starting-server
(begin ;; gotta exit nicely
;;(BB> "http-transport: ->collision")
(tasks:server-set-state! (db:delay-if-busy tdbdat) server-id "collision")
(http-transport:server-shutdown server-id port))))))
;; when things go wrong we don't want to be doing the various queries too often
;; so we strive to run this stuff only every four seconds or so.
|
| ︙ | ︙ |
Modified server.scm from [5f46daa549] to [055a606575].
| ︙ | ︙ | |||
224 225 226 227 228 229 230 |
(lambda ()
(read-line)))
#f))))
(define (server:read-dotserver->server-url areapath)
(let* ((temp (server:read-dotserver areapath))
(tokens (if temp (string-split temp ":") '())))
| | | > > > > > > > | | > | | | 224 225 226 227 228 229 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 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 |
(lambda ()
(read-line)))
#f))))
(define (server:read-dotserver->server-url areapath)
(let* ((temp (server:read-dotserver areapath))
(tokens (if temp (string-split temp ":") '())))
(if (eq? 4 (length tokens))
(string-join (list-ref tokens 0) ":" (list-ref tokens 1))
#f)))
(define (server:read-dotserver->pid areapath)
(let* ((temp (server:read-dotserver areapath))
(tokens (if temp (string-split temp ":") '())))
(if (eq? 4 (length tokens))
(list-ref tokens 2)
#f)))
(define (server:read-dotserver->transport areapath)
(let* ((temp (server:read-dotserver areapath))
(tokens (if temp (string-split temp ":") '())))
(if (eq? 4 (length tokens))
(string->symbol (list-ref tokens 3))
#f)))
(define (server:running-or-starting? areapath) ;; Note: may be unreiable on non-homehost due to NFS lag
(or (server:read-dotserver areapath) (server:start-attempted? areapath)))
;; write a .server file in *toppath* with hostport
;; return #t on success, #f otherwise
;;
(define (server:write-dotserver areapath host port pid transport)
(let ((lock-file (conc areapath "/.server.lock"))
(server-file (conc areapath "/.server"))
(payload (conc host ":" port ":" pid ":" transport)))
(if (common:simple-file-lock lock-file)
(let ((res (handle-exceptions
exn
#f ;; failed for some reason, for the moment simply return #f
(with-output-to-file server-file
(lambda ()
(print payload)))
#t)))
(debug:print-info 0 *default-log-port* "server file " server-file " for " payload " created")
(common:simple-file-release-lock lock-file)
res)
#f)))
(define (server:remove-dotserver-file areapath hostport)
(let ((serverurl (server:read-dotserver->server-url areapath))
(server-file (conc areapath "/.server"))
|
| ︙ | ︙ |
Modified tasks.scm from [7914349b64] to [65c2fe0cbf].
| ︙ | ︙ | |||
328 329 330 331 332 333 334 335 336 337 338 339 340 341 |
(conc "SELECT " selstr " FROM servers WHERE state in ('available','running','dbprep') ORDER BY start_time DESC;")
)
(vector header res)))
(define (tasks:get-server mdb run-id #!key (retries 10))
(let ((res #f)
(best #f))
(handle-exceptions
exn
(begin
(print-call-chain (current-error-port))
(debug:print 0 *default-log-port* "WARNING: tasks:get-server db access error.")
(debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
(debug:print 0 *default-log-port* " for run " run-id)
| > > > > | 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 |
(conc "SELECT " selstr " FROM servers WHERE state in ('available','running','dbprep') ORDER BY start_time DESC;")
)
(vector header res)))
(define (tasks:get-server mdb run-id #!key (retries 10))
(let ((res #f)
(best #f))
(set! res (vector id interface port pubport transport pid hostname)))
(handle-exceptions
exn
(begin
(print-call-chain (current-error-port))
(debug:print 0 *default-log-port* "WARNING: tasks:get-server db access error.")
(debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
(debug:print 0 *default-log-port* " for run " run-id)
|
| ︙ | ︙ |