Megatest

Check-in [8262fac699]
Login
Overview
Comment:Delay opening the database until *after* the server is started
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60
Files: files | file ages | folders
SHA1: 8262fac699f964e49e546f034aa03b61400b433f
User & Date: matt on 2014-08-19 23:21:31
Other Links: branch diff | manifest | tags
Context
2014-08-19
23:59
Servers will wait until no running tests before exiting check-in: fac1a3d1e7 user: matt tags: v1.60
23:21
Delay opening the database until *after* the server is started check-in: 8262fac699 user: matt tags: v1.60
2014-08-13
16:13
Merged in v1.55 changes check-in: f870afe4d0 user: mrwellan tags: v1.60
Changes

Modified http-transport.scm from [beba9d1ded] to [779f20d631].

67
68
69
70
71
72
73
74

75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91

92
93
94
95
96
97
98
67
68
69
70
71
72
73

74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90

91
92
93
94
95
96
97
98







-
+
















-
+







	 (ipaddrstr       (let ((ipstr (if (string=? "-" hostn)
					   ;; (string-intersperse (map number->string (u8vector->list (hostname->ip hostname))) ".")
					   (server:get-best-guess-address hostname)
					   #f)))
			    (if ipstr ipstr hostn))) ;; hostname))) 
	 (start-port      (open-run-close tasks:server-get-next-port tasks:open-db))
	 (link-tree-path  (configf:lookup *configdat* "setup" "linktree")))
    (set! db *inmemdb*)
    ;; (set! db *inmemdb*)
    (root-path     (if link-tree-path 
		       link-tree-path
		       (current-directory))) ;; WARNING: SECURITY HOLE. FIX ASAP!
    (handle-directory spiffy-directory-listing)
    ;; http-transport:handle-directory) ;; simple-directory-handler)
    ;; Setup the web server and a /ctrl interface
    ;;
    (vhost-map `(((* any) . ,(lambda (continue)
			       ;; open the db on the first call 
				 ;; This is were we set up the database connections
			       (let* (($   (request-vars source: 'both))
				      (dat ($ 'dat))
				      (res #f))
				 (cond
				  ((equal? (uri-path (request-uri (current-request)))
					   '(/ "api"))
				   (send-response body:    (api:process-request db $) ;; the $ is the request vars proc
				   (send-response body:    (api:process-request *inmemdb* $) ;; the $ is the request vars proc
						  headers: '((content-type text/plain)))
				   (mutex-lock! *heartbeat-mutex*)
				   (set! *last-db-access* (current-seconds))
				   (mutex-unlock! *heartbeat-mutex*))
				  ;; This is the /ctrl path where data is handed to the server and
				  ;; responses 
				  ;; ((equal? (uri-path (request-uri (current-request)))
311
312
313
314
315
316
317
318

319
320
321
322
323
324
325
311
312
313
314
315
316
317

318
319
320
321
322
323
324
325







-
+







	 (api-req      (make-request method: 'POST uri: api-uri))
	 (server-dat   (vector iface port api-uri api-url api-req)))
    server-dat))

;; run http-transport:keep-running in a parallel thread to monitor that the db is being 
;; used and to shutdown after sometime if it is not.
;;
(define (http-transport:keep-running server-id)
(define (http-transport:keep-running server-id run-id)
  ;; if none running or if > 20 seconds since 
  ;; server last used then start shutdown
  ;; This thread waits for the server to come alive
  (let* ((server-info (let loop ((start-time (current-seconds))
				 (changed    #t)
				 (last-sdat  "not this"))
                        (let ((sdat #f))
356
357
358
359
360
361
362
363

364
365


366

367
368
369
370
371
372
373
356
357
358
359
360
361
362

363
364
365
366
367

368
369
370
371
372
373
374
375







-
+


+
+
-
+








	(if *inmemdb* (db:sync-touched *inmemdb* *run-id* force-sync: #t))
	(set! sync-time  (- (current-milliseconds) start-time))
	(set! rem-time (quotient (- 4000 sync-time) 1000))
	(debug:print 0 "SYNC: time= " sync-time ", rem-time=" rem-time)

      ;;
      ;; set_running after our first pass through
      ;; set_running after our first pass through and start the db
      ;;
      (if (eq? server-state 'available)
	  (begin
	    (set! *inmemdb*  (db:setup run-id))
	  (tasks:server-set-state! tdb server-id "running"))
	    (tasks:server-set-state! tdb server-id "running")))

      (if (and (<= rem-time 4)
	       (> rem-time 0))
	  (thread-sleep! rem-time)
	  (thread-sleep! 4))) ;; fallback for if the math is changed ...
      
      (if (< count 1) ;; 3x3 = 9 secs aprox
465
466
467
468
469
470
471
472

473
474




475



476
477
478
479
480
481
482
467
468
469
470
471
472
473

474
475
476
477
478
479
480

481
482
483
484
485
486
487
488
489
490







-
+


+
+
+
+
-
+
+
+







				   (http-transport:run 
				    (if (args:get-arg "-server")
					(args:get-arg "-server")
					"-")
				    run-id
				    server-id)) "Server run"))
	       (th3 (make-thread (lambda ()
				   (http-transport:keep-running server-id))
				   (http-transport:keep-running server-id run-id))
				 "Keep running")))
	  ;; Database connection


	  ;; don't start the db here

	  (set! *inmemdb*  (db:setup run-id))
	  ;; (set! *inmemdb*  (db:setup run-id))


	  (thread-start! th2)
	  (thread-start! th3)
	  (set! *didsomething* #t)
	  (thread-join! th2)
	  (exit)))))

(define (http-transport:server-signal-handler signum)