Megatest

Check-in [76c7c0f408]
Login
Overview
Comment:More untested changes
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | multi-area
Files: files | file ages | folders
SHA1: 76c7c0f408db5c8df0961e1a99c88a37c8cfc146
User & Date: matt on 2015-04-05 23:25:04
Other Links: branch diff | manifest | tags
Context
2015-04-05
23:50
Old dashboard now working check-in: 189c778920 user: matt tags: multi-area
23:25
More untested changes check-in: 76c7c0f408 user: matt tags: multi-area
23:16
more untested cleanup check-in: c9180c4d63 user: matt tags: multi-area
Changes

Modified http-transport.scm from [ac17ed4fcc] to [c343c9b304].

67
68
69
70
71
72
73
74



75
76
77
78
79
80
81
67
68
69
70
71
72
73

74
75
76
77
78
79
80
81
82
83







-
+
+
+







	 (db              #f) ;;        (open-db)) ;; we don't want the server to be opening and closing the db unnecesarily
	 (hostname        (get-host-name))
	 (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      (portlogger:open-run-close portlogger:find-port area-dat))
	 (start-port      (portlogger:open-run-close (lambda (db)
						       (portlogger:find-port db area-dat))
						     area-dat))
	 (link-tree-path  (configf:lookup configdat "setup" "linktree")))
    ;; (set! db *inmemdb*)
    (debug:print-info 0 "portlogger recommended port: " start-port)
    (root-path     (if link-tree-path 
		       link-tree-path
		       (current-directory))) ;; WARNING: SECURITY HOLE. FIX ASAP!
    (handle-directory spiffy-directory-listing)
130
131
132
133
134
135
136
137



138
139
140
141
142
143
144




145
146
147
148
149
150
151
132
133
134
135
136
137
138

139
140
141
142
143
144
145
146
147

148
149
150
151
152
153
154
155
156
157
158







-
+
+
+






-
+
+
+
+







     (begin
       (print-error-message exn)
       (if (< portnum 64000)
	   (begin 
	     (debug:print 0 "WARNING: attempt to start server failed. Trying again ...")
	     (debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
	     (debug:print 0 "exn=" (condition->list exn))
	     (portlogger:open-run-close portlogger:set-failed area-dat portnum)
	     (portlogger:open-run-close (lambda (db)
					  (portlogger:set-failed db area-dat))
					area-dat portnum)
	     (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 portlogger:find-port area-dat)
					      (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
     (set! *server-info* (list ipaddrstr portnum))
396
397
398
399
400
401
402
403

404
405
406
407
408
409
410
403
404
405
406
407
408
409

410
411
412
413
414
415
416
417







-
+







				      (exit))
				    (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-timeout (server:get-timeout area-dat)))
    (let loop ((count         0)
	       (server-state 'available)
	       (bad-sync-count 0))

      ;; Use this opportunity to sync the inmemdb to db
      (if *inmemdb* 
	  (let ((start-time (current-milliseconds))
497
498
499
500
501
502
503
504




505
506
507
508
509
510
511
504
505
506
507
508
509
510

511
512
513
514
515
516
517
518
519
520
521







-
+
+
+
+







    ;; 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 portlogger:set-port area-dat port "released")
    (portlogger:open-run-close 
     (lambda (db)
       (portlogger:set-port db area-dat))
     area-dat port "released")
    (thread-sleep! 5)
    (debug:print-info 0 "Max cached queries was    " *max-cache-size*)
    (debug:print-info 0 "Number of cached writes   " *number-of-writes*)
    (debug:print-info 0 "Average cached write time "
		      (if (eq? *number-of-writes* 0)
			  "n/a (no writes)"
			  (/ *writes-total-delay*