︙ | | | ︙ | |
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
|
common:get-normalized-cpu-load-raw
common:unix-ping
launch:is-test-alive
common:get-num-cpus
common:wait-for-normalized-load
common:wait-for-cpuload
tasks:kill-server
server:get-logs-list
server:get-list
server:get-num-alive
server:get-best
server:get-first-best
server:get-rand-best
server:record->id
server:get-num-servers
server:logf-get-start-info
get-uname
realpath
common:real-path
common:get-disk-space-used
|
|
|
|
|
|
|
|
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
|
common:get-normalized-cpu-load-raw
common:unix-ping
launch:is-test-alive
common:get-num-cpus
common:wait-for-normalized-load
common:wait-for-cpuload
tasks:kill-server
;; server:get-logs-list
;; server:get-list
;; server:get-num-alive
;; server:get-best
;; server:get-first-best
;; server:get-rand-best
server:record->id
server:get-num-servers
server:logf-get-start-info
get-uname
realpath
common:real-path
common:get-disk-space-used
|
︙ | | | ︙ | |
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
|
(thread-sleep! 0.5)
(if (file-exists? gzfile) (delete-file gzfile))
(system (conc "gzip " logfile))
(unset-environment-variable! "TARGETHOST_LOGF")
(unset-environment-variable! "TARGETHOST"))))
(define (server:get-logs-list area-path)
(let* (;; (server-logs-cmd (conc "grep -iL exiting " area-path "/logs/server-*-*.log"))
;; (server-logs (string-split (string-chomp (with-input-from-pipe server-logs-cmd read-string))))
(server-logs (glob (conc area-path"/logs/server-*-*.log")))
)
server-logs))
;; get a list of servers with all relevant data
;; ( mod-time host port start-time pid )
;;
(define (server:get-list areapath #!key (limit #f))
(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"))
'()
|
|
|
|
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
|
(thread-sleep! 0.5)
(if (file-exists? gzfile) (delete-file gzfile))
(system (conc "gzip " logfile))
(unset-environment-variable! "TARGETHOST_LOGF")
(unset-environment-variable! "TARGETHOST"))))
#;(define (server:get-logs-list area-path)
(let* (;; (server-logs-cmd (conc "grep -iL exiting " area-path "/logs/server-*-*.log"))
;; (server-logs (string-split (string-chomp (with-input-from-pipe server-logs-cmd read-string))))
(server-logs (glob (conc area-path"/logs/server-*-*.log")))
)
server-logs))
;; get a list of servers with all relevant data
;; ( mod-time host port start-time pid )
;;
#;(define (server:get-list areapath #!key (limit #f))
(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"))
'()
|
︙ | | | ︙ | |
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
|
(if (null? tal)
(if (and limit
(> (length new-res) limit))
new-res ;; (take new-res limit) <= need intelligent sorting before this will work
new-res)
(loop (string-chomp (car tal)) (cdr tal) new-res)))))))))
(define (server:get-num-alive srvlst)
(let ((num-alive 0))
(for-each
(lambda (server)
(handle-exceptions
exn
(begin
(debug:print-info 0 *default-log-port* "Unable to get server start-time and/or mod-time from " server ", exn=" exn))
|
|
|
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
|
(if (null? tal)
(if (and limit
(> (length new-res) limit))
new-res ;; (take new-res limit) <= need intelligent sorting before this will work
new-res)
(loop (string-chomp (car tal)) (cdr tal) new-res)))))))))
#;(define (server:get-num-alive srvlst)
(let ((num-alive 0))
(for-each
(lambda (server)
(handle-exceptions
exn
(begin
(debug:print-info 0 *default-log-port* "Unable to get server start-time and/or mod-time from " server ", exn=" exn))
|
︙ | | | ︙ | |
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
|
;; active (i.e. mod-time < 10 seconds
;;
;; mod-time host port start-time pid
;;
;; sort by start-time descending. I.e. get the oldest first. Young servers will thus drop off
;; and servers should stick around for about two hours or so.
;;
(define (server:get-best srvlst)
(let* ((nums (server:get-num-servers))
(now (current-seconds))
(slst (sort
(filter (lambda (rec)
(if (and (list? rec)
(> (length rec) 2))
(let ((start-time (list-ref rec 3))
|
|
|
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
|
;; active (i.e. mod-time < 10 seconds
;;
;; mod-time host port start-time pid
;;
;; sort by start-time descending. I.e. get the oldest first. Young servers will thus drop off
;; and servers should stick around for about two hours or so.
;;
#;(define (server:get-best srvlst)
(let* ((nums (server:get-num-servers))
(now (current-seconds))
(slst (sort
(filter (lambda (rec)
(if (and (list? rec)
(> (length rec) 2))
(let ((start-time (list-ref rec 3))
|
︙ | | | ︙ | |
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
|
(lambda (a b)
(< (list-ref a 3)
(list-ref b 3))))))
(if (> (length slst) nums)
(take slst nums)
slst)))
(define (server:get-first-best areapath)
(let ((srvrs (server:get-best (server:get-list areapath))))
(if (and srvrs
(not (null? srvrs)))
(car srvrs)
#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)))
|
|
|
|
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
|
(lambda (a b)
(< (list-ref a 3)
(list-ref b 3))))))
(if (> (length slst) nums)
(take slst nums)
slst)))
#;(define (server:get-first-best areapath)
(let ((srvrs (server:get-best (server:get-list areapath))))
(if (and srvrs
(not (null? srvrs)))
(car srvrs)
#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)))
|
︙ | | | ︙ | |