Overview
Context
Changes
Added tests/simplerun/simple.scm version [f0b5d05c2f].
Modified ulex-simple/dbmgr.scm
from [c089e1190f]
to [baa038b013].
︙ | | |
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
|
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
|
-
+
|
(bdat-time-to-exit-set! *bdat* #t)
(delete-pkt)
(thread-sleep! 0.2)
(exit)))
sdat))
(begin ;; sdat not yet contains server info
(debug:print-info 0 *default-log-port* "Still waiting, last-sdat=" last-sdat)
(sleep 4)
(thread-sleep! 4)
(if (> (- (current-seconds) start-time) 120) ;; been waiting for two minutes
(begin
(debug:print-error 0 *default-log-port* "transport appears to have died, exiting server")
(exit))
(loop start-time
(equal? sdat last-sdat)
sdat))))))))
|
︙ | | |
Modified ulex-simple/ulex.scm
from [52358cb04f]
to [95a5f80a6e].
︙ | | |
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
|
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
|
+
+
+
-
+
-
+
-
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+
|
;;
;; NOTE: qrykey is what was called the "cookie" previously
;;
;; retval tells send to expect and wait for return data (one line) and return it or time out
;; this is for ping where we don't want to necessarily have set up our own server yet.
;;
(define (send-receive udata host-port cmd params)
(let* ((host-port-lst (string-split host-port ":"))
(host (car host-port-lst))
(port (string->number (cadr host-port-lst)))
(let* ((my-host-port (udat-host-port udata)) ;; remote will return to this
(my-host-port (and udata (udat-host-port udata))) ;; remote will return to this
(isme (equal? host-port my-host-port)) ;; calling myself?
;; dat is a self-contained work block that can be sent or handled locally
(dat (list my-host-port 'qrykey cmd params #;(cons (current-seconds)(current-milliseconds)))))
(cond
(isme (do-work udata dat)) ;; no transmission needed
(else
(handle-exceptions ;; TODO - MAKE THIS EXCEPTION CMD SPECIFIC?
exn
(message exn)
(begin
;; (mutex-lock! *send-mutex*) ;; DOESN'T SEEM TO HELP
(let-values (((inp oup)(tcp-connect host-port)))
(let-values (((inp oup)(tcp-connect host port)))
(let ((res (if (and inp oup)
(begin
(serialize dat oup)
(close-output-port oup)
(deserialize inp))
(begin
(print "ERROR: send called but no receiver has been setup. Please call setup first!")
#f))))
(close-input-port inp)
;; (mutex-unlock! *send-mutex*) ;; DOESN'T SEEM TO HELP
res)))))))) ;; res will always be 'ack unless return-method is direct
;;======================================================================
;; work queues - this is all happening on the listener side
;;======================================================================
;; move the logic to return the result somewhere else?
;;
(define (do-work uconn rdat)
(let* ((proc (udat-work-proc uconn))) ;; get it each time - conceivebly it could change
(let* () ;; get it each time - conceivebly it could change
;; put this following into a do-work procedure
(match rdat
((rem-host-port qrykey cmd params)
(case cmd
((ping) #t) ;; bypass calling the proc
(else
(let* ((proc (udat-work-proc uconn))
(let* ((start-time (current-milliseconds))
(result (proc rem-host-port qrykey cmd params))
(end-time (current-milliseconds))
(run-time (- end-time start-time)))
result))
(start-time (current-milliseconds))
(result (proc rem-host-port qrykey cmd params))
(end-time (current-milliseconds))
(run-time (- end-time start-time)))
result))))
(else
(print "ERROR: rdat "rdat", did not match rem-host-port qrykey cmd params")))))
;;======================================================================
;; misc utils
;;======================================================================
|
︙ | | |