︙ | | | ︙ | |
435
436
437
438
439
440
441
442
443
444
445
446
447
448
|
overwritten by values set in config files.
-server -|hostname : start the server (reduces contention on megatest.db), use
- to automatically figure out hostname
-adjutant C,M : start the server/adjutant with allocated cores C and Mem M (Gig),
use 0,0 to auto use full machine
-transport http|rpc : use http or rpc for transport (default is http)
-log logfile : send stdout and stderr to logfile
-list-servers : list the servers
-kill-servers : kill all servers
-repl : start a repl (useful for extending megatest)
-load file.scm : load and run file.scm
-mark-incompletes : find and mark incomplete tests
-ping run-id|host:port : ping server, exit with 0 if found
-debug N|N,M,O... : enable debug 0-N or N and M and O ...
|
>
|
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
|
overwritten by values set in config files.
-server -|hostname : start the server (reduces contention on megatest.db), use
- to automatically figure out hostname
-adjutant C,M : start the server/adjutant with allocated cores C and Mem M (Gig),
use 0,0 to auto use full machine
-transport http|rpc : use http or rpc for transport (default is http)
-log logfile : send stdout and stderr to logfile
-autolog logfilebase : appends pid and host to logfilebase for logfile
-list-servers : list the servers
-kill-servers : kill all servers
-repl : start a repl (useful for extending megatest)
-load file.scm : load and run file.scm
-mark-incompletes : find and mark incomplete tests
-ping run-id|host:port : ping server, exit with 0 if found
-debug N|N,M,O... : enable debug 0-N or N and M and O ...
|
︙ | | | ︙ | |
628
629
630
631
632
633
634
635
636
637
638
639
640
641
|
"-var"
"-dumpmode"
"-run-id"
"-ping"
"-refdb2dat"
"-o"
"-log"
"-sync-log"
"-since"
"-fields"
"-recover-test" ;; run-id,test-id - used internally to recover a test stuck in RUNNING state
"-sort"
"-target-db"
"-source-db"
|
>
|
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
|
"-var"
"-dumpmode"
"-run-id"
"-ping"
"-refdb2dat"
"-o"
"-log"
"-autolog"
"-sync-log"
"-since"
"-fields"
"-recover-test" ;; run-id,test-id - used internally to recover a test stuck in RUNNING state
"-sort"
"-target-db"
"-source-db"
|
︙ | | | ︙ | |
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
|
;; (list? n))
;; (member *verbosity* n))))
;; this segment will run launch:setup only if -log is not set. This is fairly safe as servers are not
;; manually started and thus should never be started in a non-megatest area. Thus no need to handle situation
;; where (launch:setup) returns #f?
;;
(if (or (args:get-arg "-log")#;(args:get-arg "-server")) ;; redirect the log always when a server
(handle-exceptions
exn
(begin
(print "ERROR: Failed to switch to log output. " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn)
)
(let* ((tl (or (args:get-arg "-log")(launch:setup))) ;; run launch:setup if -server, ensure we do NOT run launch:setup if -log specified
(logf (or (args:get-arg "-log") ;; use -log unless we are a server, then craft a logfile name
(conc tl "/logs/server-" (current-process-id) "-" (get-host-name) ".log")))
(oup (open-logfile logf)))
(if (not (args:get-arg "-log"))
(hash-table-set! args:arg-hash "-log" logf)) ;; fake out future queries of -log
(debug:print-info 0 *default-log-port* "Sending log output to " logf)
(set! *default-log-port* oup))))
(if (or (args:get-arg "-h")
(args:get-arg "-help")
|
|
>
>
>
|
|
>
|
|
|
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
|
;; (list? n))
;; (member *verbosity* n))))
;; this segment will run launch:setup only if -log is not set. This is fairly safe as servers are not
;; manually started and thus should never be started in a non-megatest area. Thus no need to handle situation
;; where (launch:setup) returns #f?
;;
(if (or (args:get-arg "-log") ;;(args:get-arg "-server") ;; redirect the log always when a server
(args:get-arg "-autolog"))
(handle-exceptions
exn
(begin
(print "ERROR: Failed to switch to log output. " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn)
)
(let* ((tl (or (args:get-arg "-log")
(args:get-arg "-autolog") ;; autolog provides the basename .../logs/something- for the logfile
(launch:setup))) ;; run launch:setup if -server, ensure we do NOT run launch:setup if -log specified
(logf (or (args:get-arg "-log") ;; use -log unless we are a server, then craft a logfile name
(conc tl (current-process-id)"-"(get-host-name)".log")
(conc tl "/logs/server-" (current-process-id) "-" (get-host-name) ".log")))
(oup (open-logfile logf)))
(if (not (args:get-arg "-log"))
(hash-table-set! args:arg-hash "-log" logf)) ;; fake out future queries of -log
(debug:print-info 0 *default-log-port* "Sending log output to " logf)
(set! *default-log-port* oup))))
(if (or (args:get-arg "-h")
(args:get-arg "-help")
|
︙ | | | ︙ | |
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
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
|
(adjutant-run)
(set! *didsomething* #t)))
(if (or (args:get-arg "-list-servers")
(args:get-arg "-kill-servers"))
(let ((tl (launch:setup)))
(if tl ;; all roads from here exit
(let* ((servers (server:get-list *toppath*))
(fmtstr "~8a~22a~20a~20a~8a\n"))
(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
;;======================================================================
|
|
>
>
>
>
>
>
>
>
>
|
|
|
<
<
<
<
<
>
|
|
|
<
|
>
|
<
|
>
|
|
<
<
<
|
1139
1140
1141
1142
1143
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
|
(adjutant-run)
(set! *didsomething* #t)))
(if (or (args:get-arg "-list-servers")
(args:get-arg "-kill-servers"))
(let ((tl (launch:setup)))
(if tl ;; all roads from here exit
(let* ((servers (rmt:get-servers-info *toppath*))
(fmtstr "~8a~22a~20a~20a~8a\n"))
;; id INTEGER PRIMARY KEY,
;; host TEXT,
;; 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
;;======================================================================
|
︙ | | | ︙ | |