Megatest

Check-in [3f14d7d23e]
Login
Overview
Comment:Servers now working again
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | multi-area
Files: files | file ages | folders
SHA1: 3f14d7d23edc28f89d8809c88bc5dab8e5d2070e
User & Date: matt on 2015-04-06 01:04:48
Other Links: branch diff | manifest | tags
Context
2015-04-06
01:09
Servers now working again, including clean shutdown check-in: 4d4bfbb125 user: matt tags: multi-area
01:04
Servers now working again check-in: 3f14d7d23e user: matt tags: multi-area
00:17
More clean up check-in: 94c4b16ab4 user: matt tags: multi-area
Changes

Modified http-transport.scm from [e34726a39d] to [f7503f384b].

142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
	     (debug:print 0 "WARNING: failed to start on portnum: " portnum ", trying next port")
	     (thread-sleep! 0.1)

	     ;; get_next_port goes here
	     (http-transport:try-start-server run-id
					      ipaddrstr
					      (portlogger:open-run-close 
					       (lambda (db server-id)
						 (portlogger:find-port db area-dat server-id))
					       area-dat)
					      server-id
					      area-dat))
	   (begin
	     (tasks:server-force-clean-run-record (db:delay-if-busy tdbdat area-dat) run-id ipaddrstr portnum " http-transport:try-start-server")
	     (print "ERROR: Tried and tried but could not start the server"))))
     ;; any error in following steps will result in a retry







|
|







142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
	     (debug:print 0 "WARNING: failed to start on portnum: " portnum ", trying next port")
	     (thread-sleep! 0.1)

	     ;; get_next_port goes here
	     (http-transport:try-start-server run-id
					      ipaddrstr
					      (portlogger:open-run-close 
					       (lambda (db)
						 (portlogger:find-port db area-dat))
					       area-dat)
					      server-id
					      area-dat))
	   (begin
	     (tasks:server-force-clean-run-record (db:delay-if-busy tdbdat area-dat) run-id ipaddrstr portnum " http-transport:try-start-server")
	     (print "ERROR: Tried and tried but could not start the server"))))
     ;; any error in following steps will result in a retry
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
      ;; Use this opportunity to sync the inmemdb to db
      (if *inmemdb* 
	  (let ((start-time (current-milliseconds))
		(sync-time  #f)
		(rem-time   #f))
	    ;; inmemdb is a dbstruct
	    (condition-case
	     (db:sync-touched *inmemdb* *run-id* force-sync: #t)
	     ((sync-failed)(cond
			    ((> bad-sync-count 10) ;; time to give up
			     (http-transport:server-shutdown server-id port area-dat))
			    (else ;; (> bad-sync-count 0)  ;; we've had a fail or two, delay and loop
			     (thread-sleep! 5)
			     (loop count server-state (+ bad-sync-count 1)))))
	     ((exn)







|







415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
      ;; Use this opportunity to sync the inmemdb to db
      (if *inmemdb* 
	  (let ((start-time (current-milliseconds))
		(sync-time  #f)
		(rem-time   #f))
	    ;; inmemdb is a dbstruct
	    (condition-case
	     (db:sync-touched *inmemdb* area-dat *run-id* force-sync: #t)
	     ((sync-failed)(cond
			    ((> bad-sync-count 10) ;; time to give up
			     (http-transport:server-shutdown server-id port area-dat))
			    (else ;; (> bad-sync-count 0)  ;; we've had a fail or two, delay and loop
			     (thread-sleep! 5)
			     (loop count server-state (+ bad-sync-count 1)))))
	     ((exn)
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
	  (http-transport:server-shutdown server-id port area-dat)))))

(define (http-transport:server-shutdown server-id port area-dat)
  (let ((tdbdat (tasks:open-db area-dat)))
    (debug:print-info 0 "Starting to shutdown the server.")
    ;; need to delete only *my* server entry (future use)
    (set! *time-to-exit* #t)
    (if *inmemdb* (db:sync-touched *inmemdb* *run-id* force-sync: #t))
    ;;
    ;; start_shutdown
    ;;
    (tasks:server-set-state! (db:delay-if-busy tdbdat area-dat) server-id "shutting-down")
    (portlogger:open-run-close 
     (lambda (db port yada)
       (portlogger:set-port db area-dat port yada))







|







499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
	  (http-transport:server-shutdown server-id port area-dat)))))

(define (http-transport:server-shutdown server-id port area-dat)
  (let ((tdbdat (tasks:open-db area-dat)))
    (debug:print-info 0 "Starting to shutdown the server.")
    ;; need to delete only *my* server entry (future use)
    (set! *time-to-exit* #t)
    (if *inmemdb* (db:sync-touched *inmemdb* area-dat *run-id* force-sync: #t))
    ;;
    ;; start_shutdown
    ;;
    (tasks:server-set-state! (db:delay-if-busy tdbdat area-dat) server-id "shutting-down")
    (portlogger:open-run-close 
     (lambda (db port yada)
       (portlogger:set-port db area-dat port yada))

Modified server.scm from [e081f645f7] to [027ef0dacd].

235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
	   (loop (read-line) inl))))))

(define (server:login toppath area-dat)
  (lambda (toppath)
    (set! *last-db-access* (current-seconds))
    (if (equal? (megatest:area-path area-dat) toppath)
	(begin
	  ;; (debug:print-info 2 "login successful")
	  #t)
	(begin
	  ;; (debug:print-info 2 "login failed")
	  #f))))

(define (server:get-timeout area-dat)
  (let ((tmo (configf:lookup  (megatest:area-configdat area-dat) "server" "timeout")))
    (if (and (string? tmo)
	     (string->number tmo))
	(* 60 60 (string->number tmo))
	;; (* 3 24 60 60) ;; default to three days
	(* 60 1)         ;; default to one minute
	;; (* 60 60 25)      ;; default to 25 hours
	)))








|


|












235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
	   (loop (read-line) inl))))))

(define (server:login toppath area-dat)
  (lambda (toppath)
    (set! *last-db-access* (current-seconds))
    (if (equal? (megatest:area-path area-dat) toppath)
	(begin
	  (debug:print-info 2 "login successful")
	  #t)
	(begin
	  (debug:print-info 2 "login failed")
	  #f))))

(define (server:get-timeout area-dat)
  (let ((tmo (configf:lookup  (megatest:area-configdat area-dat) "server" "timeout")))
    (if (and (string? tmo)
	     (string->number tmo))
	(* 60 60 (string->number tmo))
	;; (* 3 24 60 60) ;; default to three days
	(* 60 1)         ;; default to one minute
	;; (* 60 60 25)      ;; default to 25 hours
	)))