Megatest

Check-in [5272b8e023]
Login
Overview
Comment:Trim some of the server records returned from get-list
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | server-log-handshaking
Files: files | file ages | folders
SHA1: 5272b8e023dc53ab557c519a59fada3a53e2061a
User & Date: matt on 2017-01-29 16:10:56
Other Links: branch diff | manifest | tags
Context
2017-01-29
16:33
Deprecate api parallel message check-in: a642f429b1 user: matt tags: server-log-handshaking
16:10
Trim some of the server records returned from get-list check-in: 5272b8e023 user: matt tags: server-log-handshaking
15:33
Added megatest version to server log output for future use. Use last touch time on megatest.db to decide on doing a sync, this allows concurrent servers to not fight to do the sync back. check-in: d2c1247c44 user: matt tags: server-log-handshaking
Changes

Modified dcommon.scm from [8fb41f6f61] to [4355903cc1].

618
619
620
621
622
623
624
625

626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642

643
644
645
646
647
648
649
618
619
620
621
622
623
624

625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641

642
643
644
645
646
647
648
649







-
+
















-
+







				     #:numcol 7
				     #:numcol-visible 7
				     #:numlin-visible 5
				     ))
	 (colnames       (list "Id" "MTver" "Pid" "Host" "Interface:OutPort" "RunTime" "State" "RunId"))
	 (updater        (lambda ()
			   (if (dashboard:monitor-changed? commondat tabdat)
			       (let ((servers  (server:get-list *toppath*)))
			       (let ((servers  (server:get-list *toppath* limit: 10)))
				 ;; (tasks:get-all-servers (db:delay-if-busy tdbdat))))
				 (iup:attribute-set! servers-matrix "NUMLIN" (length servers))
				 ;; (set! colnum 0)
				 ;; (for-each (lambda (colname)
				 ;;    	 ;; (print "colnum: " colnum " colname: " colname)
				 ;;    	 (iup:attribute-set! servers-matrix (conc "0:" colnum) colname)
				 ;;    	 (set! colnum (+ 1 colnum)))
				 ;;           colnames)
				 (set! rownum 1)
				 (for-each 
				  (lambda (server)
				    (set! colnum 0)
				    (match-let (((mod-time host port start-time pid)
						 server))
				      (let* ((uptime  (- (current-seconds) mod-time))
					     (runtime (if start-time
							  (- (current-seconds) start-time)
							  (- mod-time start-time)
							  0))
					     (vals (list "-"  ;; (vector-ref server 0) ;; Id
							 "-"  ;; (vector-ref server 9) ;; MT-Ver
							 pid  ;; (vector-ref server 1) ;; Pid
							 host ;; (vector-ref server 2) ;; Hostname
							 (conc host ":" port) ;; (conc (vector-ref server 3) ":" (vector-ref server 4)) ;; IP:Port
							 (seconds->hr-min-sec runtime) ;; (- (current-seconds) start-time)) ;; (vector-ref server 6)))

Modified server.scm from [52a242fcdc] to [b68dac663e].

158
159
160
161
162
163
164
165
166



167
168
169
170
171
172
173
174
175
176
177
178
179
180


181
182
183
184
185
186
187






188
189
190


191
192
193






194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214

215
216
217
218
219
220
221
158
159
160
161
162
163
164


165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180

181
182
183
184
185
186
187


188
189
190
191
192
193
194
195
196
197
198



199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224

225
226
227
228
229
230
231
232







-
-
+
+
+













-
+
+





-
-
+
+
+
+
+
+



+
+
-
-
-
+
+
+
+
+
+




















-
+







			    (string->number (cadr dat)) ;; port
			    (string->number (caddr dat))))))
	      (list #f #f #f)))))))

;; get a list of servers with all relevant data
;; ( mod-time host port start-time pid )
;;
(define (server:get-list areapath)
  (let ((fname-rx (regexp "^(|.*/)server-(\\d+)-(\\S+).log$")))
(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"))
	    #t
	    (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")))
		#f))
	(let ((server-logs (glob (conc areapath "/logs/server-*.log"))))
	(let* ((server-logs   (glob (conc areapath "/logs/server-*.log")))
	       (num-serv-logs (length server-logs)))
	  (if (null? server-logs)
	      '()
	      (let loop ((hed  (car server-logs))
			 (tal  (cdr server-logs))
			 (res '()))
		(let* ((mod-time (file-modification-time hed))
		       (serv-dat (server:logf-get-start-info hed))
		(let* ((mod-time  (file-modification-time hed))
		       (down-time (- (current-seconds) mod-time))
		       (serv-dat  (if (or (< num-serv-logs 10)
				  	  (< down-time day-seconds))
				     (server:logf-get-start-info hed)
				     '())) ;; don't waste time processing server files not touched in the past day if there are more than ten servers to look at
		       (serv-rec (cons mod-time serv-dat))
		       (fmatch   (string-match fname-rx hed))
		       (pid      (if fmatch (string->number (list-ref fmatch 2)) #f))
		       (new-res  (if (null? serv-dat)
				     res
		       (new-res  (cons (append serv-rec (list pid)) res)))
		  (if (null? tal)
		      new-res
				     (cons (append serv-rec (list pid)) res))))
		(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 (car tal)(cdr tal) new-res)))))))))

;; given a list of servers get a list of valid servers, i.e. at least
;; 10 seconds old, has started and is less than 1 hour old and is
;; 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 ((now (current-seconds)))
    (sort
     (filter (lambda (rec)
	       (let ((start-time (list-ref rec 3))
		     (mod-time   (list-ref rec 0)))
		 ;; (print "start-time: " start-time " mod-time: " mod-time)
		 (and start-time mod-time
		      (> (- now start-time) 1)    ;; been running at least 1 seconds
		      (< (- now mod-time)   10)   ;; still alive - file touched in last 10 seconds
		      (< (- now mod-time)   16)   ;; still alive - file touched in last 16 seconds
		      (< (- now start-time) 3600) ;; under one hour running time
		      )))
	     srvlst)
     (lambda (a b)
       (< (list-ref a 3)
	  (list-ref b 3))))))