1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
|
;; port INTEGER,
;; servkey TEXT,
;; pid TEXT,
;; ipaddr TEXT,
;; apath TEXT,
;; dbname TEXT,
;; event_time
(format #t fmtstr "pid" "Interface:port" "age (hms)" "Last mod" "State")
(format #t fmtstr "===" "==============" "=========" "========" "=====")
(for-each ;; ( mod-time host port start-time pid )
(lambda (server)
(let* ((mtm (any->number (car server)))
(mod (if mtm (- (current-seconds) mtm) "unk"))
(age (- (current-seconds)(or (any->number (list-ref server 3)) (current-seconds))))
(url (conc (cadr server) ":" (caddr server)))
(pid (list-ref server 4))
(alv (if (number? mod)(< mod 10) #f)))
(format #t
fmtstr
pid
url
(seconds->hr-min-sec age)
(seconds->hr-min-sec mod)
(if alv "alive" "dead"))
(if (and alv
(args:get-arg "-kill-servers"))
(begin
(debug:print-info 0 *default-log-port* "Attempting to kill server with pid " pid " !!needs completion!!")
#;(server:kill server)))))
(sort servers (lambda (a b)
(let ((ma (or (any->number (car a)) 9e9))
(mb (or (any->number (car b)) 9e9)))
(> ma mb)))))
;; (debug:print-info 1 *default-log-port* "Done with listservers")
(set! *didsomething* #t)
(exit))
(exit))))
;; must do, would have to add checks to many/all calls below
;;======================================================================
|
|
|
|
|
<
<
<
<
|
|
|
<
|
>
|
<
|
>
|
|
<
<
<
|
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
|
;; port INTEGER,
;; servkey TEXT,
;; pid TEXT,
;; ipaddr TEXT,
;; apath TEXT,
;; dbname TEXT,
;; event_time
(format #t fmtstr "pid" "Interface:port" "State" "dbname" "apath")
(format #t fmtstr "===" "==============" "=====" "======" "=====")
(for-each ;; ( mod-time host port start-time pid )
(lambda (server)
(match-let
(((id host port servkey pid ipaddr apath dbname event_time) server))
(format #t
fmtstr
pid
(conc host":"port)
(if (server-ready? host port servkey) "Running" "Dead")
dbname ;; (seconds->hr-min-sec mod)
apath
)
(if (args:get-arg "-kill-servers")
(begin
(debug:print-info 0 *default-log-port* "Attempting to kill server with pid " pid " !!needs completion!!")
#;(server:kill server)))))
servers)
;; (debug:print-info 1 *default-log-port* "Done with listservers")
(set! *didsomething* #t)
(exit))
(exit))))
;; must do, would have to add checks to many/all calls below
;;======================================================================
|