| ︙ | | | ︙ | |
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
|
(declare (uses mtconfigf))
(declare (uses mtargs))
(declare (uses tasksmod))
(module servermod
*
(import scheme chicken data-structures extras files)
(import (prefix sqlite3 sqlite3:) posix typed-records srfi-18
srfi-69 format ports srfi-1 matchable
directory-utils md5 message-digest regex
stack)
(import commonmod)
(import dbmod)
(import tasksmod)
(import (prefix mtargs args:))
(import (prefix mtconfigf configf:))
|
|
|
|
>
>
>
|
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
|
(declare (uses mtconfigf))
(declare (uses mtargs))
(declare (uses tasksmod))
(module servermod
*
(import scheme (chicken base) (chicken file) (chicken condition))
(import (prefix sqlite3 sqlite3:) typed-records srfi-18
srfi-69 format (chicken port) srfi-1 matchable
directory-utils md5 message-digest regex
chicken.file.posix chicken.io chicken.sort chicken.time chicken.string
chicken.process chicken.process-context chicken.process-context.posix
chicken.random system-information
stack)
(import commonmod)
(import dbmod)
(import tasksmod)
(import (prefix mtargs args:))
(import (prefix mtconfigf configf:))
|
| ︙ | | | ︙ | |
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
|
(delete-file* (common:get-sync-lock-filepath))
)
;; clear out junk records
;;
((dejunk)
(db:delay-if-busy mtdb) ;; ok to delay on mtdb
(when (file-write-access? (db:dbdat-get-path mtdb)) (db:clean-up mtdb))
(db:clean-up tmpdb)
(db:clean-up refndb))
;; sync runs, test_meta etc.
;;
((old2new)
(set! data-synced
|
|
|
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
|
(delete-file* (common:get-sync-lock-filepath))
)
;; clear out junk records
;;
((dejunk)
(db:delay-if-busy mtdb) ;; ok to delay on mtdb
(when (file-writable? (db:dbdat-get-path mtdb)) (db:clean-up mtdb))
(db:clean-up tmpdb)
(db:clean-up refndb))
;; sync runs, test_meta etc.
;;
((old2new)
(set! data-synced
|
| ︙ | | | ︙ | |
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
|
(let ((fname-rx (regexp "^(|.*/)server-(\\d+)-(\\S+).log$"))
(day-seconds (* 24 60 60)))
;; if the directory exists continue to get the list
;; otherwise attempt to create the logs dir and then
;; continue
(if (if (directory-exists? (conc areapath "/logs"))
'()
(if (file-write-access? areapath)
(begin
(condition-case
(create-directory (conc areapath "/logs") #t)
(exn (i/o file)(debug:print 0 *default-log-port* "ERROR: Cannot create directory at " (conc areapath "/logs")))
(exn ()(debug:print 0 *default-log-port* "ERROR: Unknown error attemtping to get server list.")))
(directory-exists? (conc areapath "/logs")))
'()))
|
|
|
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
|
(let ((fname-rx (regexp "^(|.*/)server-(\\d+)-(\\S+).log$"))
(day-seconds (* 24 60 60)))
;; if the directory exists continue to get the list
;; otherwise attempt to create the logs dir and then
;; continue
(if (if (directory-exists? (conc areapath "/logs"))
'()
(if (file-writable? areapath)
(begin
(condition-case
(create-directory (conc areapath "/logs") #t)
(exn (i/o file)(debug:print 0 *default-log-port* "ERROR: Cannot create directory at " (conc areapath "/logs")))
(exn ()(debug:print 0 *default-log-port* "ERROR: Unknown error attemtping to get server list.")))
(directory-exists? (conc areapath "/logs")))
'()))
|
| ︙ | | | ︙ | |
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
|
;; (print "start-time: " start-time " mod-time: " mod-time)
(and start-time mod-time
(> (- now start-time) 0) ;; been running at least 0 seconds
(< (- now mod-time) 16) ;; still alive - file touched in last 16 seconds
(< (- now start-time)
(+ (- (string->number (or (configf:lookup *configdat* "server" "runtime") "3600"))
180)
(random 360))) ;; under one hour running time +/- 180
))
#f))
srvlst)
(lambda (a b)
(< (list-ref a 3)
(list-ref b 3))))))
(if (> (length slst) nums)
|
|
|
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
|
;; (print "start-time: " start-time " mod-time: " mod-time)
(and start-time mod-time
(> (- now start-time) 0) ;; been running at least 0 seconds
(< (- now mod-time) 16) ;; still alive - file touched in last 16 seconds
(< (- now start-time)
(+ (- (string->number (or (configf:lookup *configdat* "server" "runtime") "3600"))
180)
(pseudo-random-integer 360))) ;; under one hour running time +/- 180
))
#f))
srvlst)
(lambda (a b)
(< (list-ref a 3)
(list-ref b 3))))))
(if (> (length slst) nums)
|
| ︙ | | | ︙ | |
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
|
#f)))
(define (server:get-rand-best areapath)
(let ((srvrs (server:get-best (server:get-list areapath))))
(if (and (list? srvrs)
(not (null? srvrs)))
(let* ((len (length srvrs))
(idx (random len)))
(list-ref srvrs idx))
#f)))
(define (server:record->url servr)
(match-let (((mod-time host port start-time pid)
servr))
|
|
|
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
|
#f)))
(define (server:get-rand-best areapath)
(let ((srvrs (server:get-best (server:get-list areapath))))
(if (and (list? srvrs)
(not (null? srvrs)))
(let* ((len (length srvrs))
(idx (pseudo-random-integer len)))
(list-ref srvrs idx))
#f)))
(define (server:record->url servr)
(match-let (((mod-time host port start-time pid)
servr))
|
| ︙ | | | ︙ | |