Megatest

Diff
Login

Differences From Artifact [befbabbb2c]:

To Artifact [a13dabce08]:


90
91
92
93
94
95
96
97

98
99
100
101
102
103
104
90
91
92
93
94
95
96

97
98
99
100
101
102
103
104







-
+







			     (print "ping, failed: received key \"" result "\"")
			     (set! keepwaiting #f)
			     (set! success #f)))))
		   "ping"))
	 (timeout (make-thread (lambda ()
				 (let loop ((count 0))
				   (thread-sleep! 1)
				   (print "still waiting after count seconds...")
				   (print "still waiting after " count " seconds...")
				   (if (and keepwaiting (< count 10))
				       (loop (+ count 1))))
				 (if keepwaiting
				     (begin
				       (print "timeout waiting for ping")
				       (thread-terminate! ping))))
			       "timeout")))
120
121
122
123
124
125
126
127

128
129
130
131
132
133
134


135
136

137
138
139
140
141
142
143
120
121
122
123
124
125
126

127
128
129
130
131
132


133
134
135

136
137
138
139
140
141
142
143







-
+





-
-
+
+

-
+







	  (nn-close req)
	  success))))

(define *current-delay-mutex* (make-mutex))

;; update the *current-delay* value every minute or QUEUE_CHK_DELAY seconds
(thread-start! (make-thread (lambda ()
			      (let ((delay-time (string->number (or (get-environment-variable "QUEUE_CHK_DELAY") "60"))))
			      (let ((delay-time (string->number (or (get-environment-variable "QUEUE_CHK_DELAY") "30"))))
				(let loop ()
				  (with-input-from-pipe 
				   cmd
				   (lambda ()
				     (let* ((val       (read))
					    (droop-val (if (number? val)(/ val 50) #f)))
				       ;; val is number of jobs in queue. Use a linear droop of val/50
					    (droop-val (if (number? val)(/ val 500) #f)))
				       ;; val is number of jobs in queue. Use a linear droop of val/40
				       (mutex-lock! *current-delay-mutex*)
				       (set! *current-delay* (/ (or droop-val 100) 50))
				       (set! *current-delay* (or droop-val 30)) ;; (/ (or droop-val 100) 50))
				       (mutex-unlock! *current-delay-mutex*)
				       (print "droop-val=" droop-val)
				       (thread-sleep! delay-time))))
				  (loop))))))

(let ((server-thread (make-thread (lambda ()(server rep)) "server")))
  (thread-start! server-thread)