Megatest

Diff
Login

Differences From Artifact [11086d3914]:

To Artifact [381a26e6c2]:


1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
              (debug:print 0 *default-log-port* " to switch versions you can run: \"megatest -cleanup-db\"")
              (exit 1)))))))
;;======================================================================
;;      (begin
;;	(debug:print 0 *default-log-port* "ERROR: cannot migrate version unless on homehost. Exiting.")
;;	(exit 1))))

(define (common:wait-for-homehost-load maxnormload msg)
  (let loop ((start-time (current-seconds))) ;; we saw some instances of this being called before *toppath* was set. This might be an early setup race. This delay should help but it is impossible to test...
    (if (not *toppath*)
	(begin
	  (debug:print 0 *default-log-port* "ERROR: common:wait-for-homehost-load called before *toppath* set.")
	  (thread-sleep! 30)
	  (if (< (- (current-seconds) start-time) 300)
	      (loop start-time)))))
  (case (rmt:transport-mode)
    ((http)
     (let* ((hh-dat (if (rmt:on-homehost?) ;; if we are on the homehost then pass in #f so the calls are local.
			#f
			(server:choose-server *toppath* 'homehost)))
            (hh     (if hh-dat (car hh-dat) #f)))
       (common:wait-for-normalized-load maxnormload msg hh)))
    (else
     (common:wait-for-normalized-load maxnormload msg (get-host-name)))))
    

(define (configf:write-alist cdat fname)
  (if (not (common:faux-lock fname))
      (debug:print 0 *default-log-port* "INFO: Could not get lock on " fname))
  (let* ((dat  (configf:config->alist cdat))
         (res







|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|







1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
              (debug:print 0 *default-log-port* " to switch versions you can run: \"megatest -cleanup-db\"")
              (exit 1)))))))
;;======================================================================
;;      (begin
;;	(debug:print 0 *default-log-port* "ERROR: cannot migrate version unless on homehost. Exiting.")
;;	(exit 1))))

;; (define (common:wait-for-homehost-load maxnormload msg)
;;   (let loop ((start-time (current-seconds))) ;; we saw some instances of this being called before *toppath* was set. This might be an early setup race. This delay should help but it is impossible to test...
;;     (if (not *toppath*)
;; 	(begin
;; 	  (debug:print 0 *default-log-port* "ERROR: common:wait-for-homehost-load called before *toppath* set.")
;; 	  (thread-sleep! 30)
;; 	  (if (< (- (current-seconds) start-time) 300)
;; 	      (loop start-time)))))
;;   (case (rmt:transport-mode)
;;     ((http)
;;      (let* ((hh-dat (if (rmt:on-homehost?) ;; if we are on the homehost then pass in #f so the calls are local.
;; 			#f
;; 			(server:choose-server *toppath* 'homehost)))
;;             (hh     (if hh-dat (car hh-dat) #f)))
;;        (common:wait-for-normalized-load maxnormload msg hh)))
;;     (else
;;      (common:wait-for-normalized-load maxnormload msg (get-host-name)))))
    

(define (configf:write-alist cdat fname)
  (if (not (common:faux-lock fname))
      (debug:print 0 *default-log-port* "INFO: Could not get lock on " fname))
  (let* ((dat  (configf:config->alist cdat))
         (res