Megatest

Check-in [ebc39ec805]
Login
Overview
Comment:Automated merge of server-log-handshaking/2a497f95de/integ into integ-home
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | integ-home
Files: files | file ages | folders
SHA1: ebc39ec80580b53ca1fa8d7e17c7f471c284d3a4
User & Date: matt on 2017-01-28 22:48:16
Other Links: branch diff | manifest | tags
Context
2017-01-29
16:48
Automated merge of server-log-handshaking/a642f429b1/integ into integ-home check-in: ad7df3e1eb user: matt tags: integ-home
2017-01-28
22:48
Automated merge of server-log-handshaking/2a497f95de/integ into integ-home check-in: ebc39ec805 user: matt tags: integ-home
22:34
Added timestamp touch on server logs, rock solid now with only one server being sustained. check-in: 2a497f95de user: matt tags: server-log-handshaking
21:09
Automated merge of server-log-handshaking/cc6a49cf21/integ into integ-home check-in: eeae55dd41 user: matt tags: integ-home
Changes

Modified http-transport.scm from [bbf4c4febb] to [05f38775ca].

1
2
3
4
5
6
7
8
9
10
11
12
13

14
15
16
17
18
19
20
1
2
3
4
5
6
7
8
9
10
11
12

13
14
15
16
17
18
19
20












-
+








;; Copyright 2006-2012, Matthew Welland.
;; 
;;  This program is made available under the GNU GPL version 2.0 or
;;  greater. See the accompanying file COPYING for details.
;; 
;;  This program is distributed WITHOUT ANY WARRANTY; without even the
;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;;  PURPOSE.

(require-extension (srfi 18) extras tcp s11n)

(use  srfi-1 posix regex regex-case srfi-69 hostinfo md5 message-digest) ;; sqlite3
(use  srfi-1 posix regex regex-case srfi-69 hostinfo md5 message-digest posix-extras) ;; sqlite3
;; (import (prefix sqlite3 sqlite3:))

(use spiffy uri-common intarweb http-client spiffy-request-vars intarweb spiffy-directory-listing)

;; Configurations for server
(tcp-buffer-size 2048)
(max-connections 2048) 
365
366
367
368
369
370
371
372


373
374
375
376
377
378
379
365
366
367
368
369
370
371

372
373
374
375
376
377
378
379
380







-
+
+







				    (loop start-time
					  (equal? sdat last-sdat)
					  sdat)))))))
         (iface       (car server-info))
         (port        (cadr server-info))
         (last-access 0)
	 (server-timeout (server:get-timeout))
	 (server-going  #f))
	 (server-going  #f)
	 (server-log-file (args:get-arg "-log"))) ;; always set when we are a server
    (let loop ((count         0)
	       (server-state 'available)
	       (bad-sync-count 0)
	       (start-time     (current-milliseconds)))
      ;; Use this opportunity to sync the tmp db to megatest.db
      (if (not server-going) ;; *dbstruct-db* 
	  (begin
425
426
427
428
429
430
431
432



433
434
435
436
437
438
439
426
427
428
429
430
431
432

433
434
435
436
437
438
439
440
441
442







-
+
+
+







	(if (common:low-noise-print 120 "server timeout")
	    (debug:print-info 0 *default-log-port* "Adjusted server timeout: " adjusted-timeout))
	(cond
         ((and *server-run*
		 (> (+ last-access server-timeout)
		    (current-seconds)))
          (if (common:low-noise-print 120 "server continuing")
              (debug:print-info 0 *default-log-port* "Server continuing, seconds since last db access: " (- (current-seconds) last-access)))
              (debug:print-info 0 *default-log-port* "Server continuing, seconds since last db access: " (- (current-seconds) last-access))
	      (let ((curr-time (current-seconds)))
		(change-file-times server-log-file curr-time curr-time)))
          (loop 0 server-state bad-sync-count (current-milliseconds)))
         (else
          (debug:print-info 0 *default-log-port* "Server timeed out. seconds since last db access: " (- (current-seconds) last-access))
          (http-transport:server-shutdown port)))))))

(define (http-transport:server-shutdown port)
  (let ((tdbdat (tasks:open-db)))

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

251
252
253
254
255
256
257
258
259



260
261
262
263
264
265
266
251
252
253
254
255
256
257


258
259
260
261
262
263
264
265
266
267







-
-
+
+
+








(define (server:start-and-wait areapath #!key (timeout 60))
  (let ((give-up-time (+ (current-seconds) timeout)))
    (let loop ((server-url (server:check-if-running areapath)))
      (if (or server-url
	      (> (current-seconds) give-up-time))
	  server-url
	  (begin
	    (server:kind-run areapath)
	  (let ((num-ok (server:get-best (server:get-list areapath))))
	    (if (< num-ok 2) ;; if there are no decent candidates for servers then try starting a new one
		(server:kind-run areapath))
	    (thread-sleep! 5)
	    (loop (server:check-if-running areapath)))))))

(define server:try-running server:run) ;; there is no more per-run servers ;; REMOVE ME. BUG.

(define (server:dotserver-age-seconds areapath)
  (let ((server-file (conc areapath "/.server")))

Added utils/lock-stats.sh version [3f061e6171].














1
2
3
4
5
6
7
8
9
10
11
12
13
+
+
+
+
+
+
+
+
+
+
+
+
+
#!/bin/bash

while IFS=': ' read x x x x p x x i x; do
    if ! [[ ${i}x == "x" ]];then
	if ! $(echo $i|grep EOF >/dev/null);then
	    fname=$(sudo find -L "/proc/$p/fd" -maxdepth 1 -inum "$i" -exec readlink {} \; -quit)
	    if $(echo $fname | grep megatest.db > /dev/null) || \
	       $(echo $fname | egrep '.db/\d+.db' > /dev/null);then
		echo $fname
	    fi
	fi
    fi
done < /proc/locks