Megatest

Diff
Login

Differences From Artifact [ac17ed4fcc]:

To Artifact [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*