Overview
| Comment: | Added catching of ^c and flushing of server communication so that server doesn't die |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk | v1.5110 |
| Files: | files | file ages | folders |
| SHA1: |
bb324e09458079209f8c1b1629341430 |
| User & Date: | mrwellan on 2012-11-05 13:20:08 |
| Other Links: | manifest | tags |
Context
|
2012-11-05
| ||
| 13:27 | Added catching of ^c and flushing of server communication so that server doesn't die check-in: d69a3dee28 user: mrwellan tags: trunk, v1.5111 | |
| 13:20 | Added catching of ^c and flushing of server communication so that server doesn't die check-in: bb324e0945 user: mrwellan tags: trunk, v1.5110 | |
| 10:49 | Minor clean up of messages from server check-in: 632d164e99 user: mrwellan tags: trunk, v1.5109 | |
Changes
Modified db.scm from [7d7e161003] to [c960b481ca].
| ︙ | ︙ | |||
1181 1182 1183 1184 1185 1186 1187 1188 1189 |
res))
;; params = 'target cached remparams
(define (cdb:client-call zmq-socket . params)
(debug:print-info 11 "cdb:client-call zmq-socket=" zmq-socket " params=" params)
(let ((zdat (db:obj->string params)) ;; (with-output-to-string (lambda ()(serialize params))))
(res #f))
(send-message zmq-socket zdat)
(set! res (db:string->obj (if *client-non-blocking-mode*
| > | | > | 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 |
res))
;; params = 'target cached remparams
(define (cdb:client-call zmq-socket . params)
(debug:print-info 11 "cdb:client-call zmq-socket=" zmq-socket " params=" params)
(let ((zdat (db:obj->string params)) ;; (with-output-to-string (lambda ()(serialize params))))
(res #f))
;; (signal-mask! signal/int)
(send-message zmq-socket zdat)
(set! res (db:string->obj (if *client-non-blocking-mode*
(receive-message* zmq-socket)
(receive-message zmq-socket))))
;; (signal-unmask! signal/int)
(debug:print-info 11 "zmq-socket " (car params) " res=" res)
res))
(define (cdb:set-verbosity zmq-socket val)
(cdb:client-call zmq-socket 'set-verbosity #f val))
(define (cdb:login zmq-socket keyval signature)
|
| ︙ | ︙ |
Modified megatest-version.scm from [5a6f64bceb] to [a44c5abdde].
1 2 3 4 5 | ;; Always use two digit decimal ;; 1.01, 1.02...1.10,1.11 ... 1.99,2.00.. (declare (unit megatest-version)) | | | 1 2 3 4 5 6 7 | ;; Always use two digit decimal ;; 1.01, 1.02...1.10,1.11 ... 1.99,2.00.. (declare (unit megatest-version)) (define megatest-version 1.5110) |
Modified megatest.scm from [5c2117b3b6] to [323313750f].
| ︙ | ︙ | |||
319 320 321 322 323 324 325 |
(exit) ;; must do, would have to add checks to many/all calls below
)
(exit)))
;; if not list or kill then start a client (if appropriate)
(if (or (args-defined? "-h" "-version" "-gen-megatest-area" "-gen-megatest-test")
(eq? (length (hash-table-keys args:arg-hash)) 0))
(debug:print-info 1 "Server connection not needed")
| > | | 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 |
(exit) ;; must do, would have to add checks to many/all calls below
)
(exit)))
;; if not list or kill then start a client (if appropriate)
(if (or (args-defined? "-h" "-version" "-gen-megatest-area" "-gen-megatest-test")
(eq? (length (hash-table-keys args:arg-hash)) 0))
(debug:print-info 1 "Server connection not needed")
(server:client-launch)))
;;======================================================================
;; Remove old run(s)
;;======================================================================
;; since several actions can be specified on the command line the removal
;; is done first
|
| ︙ | ︙ |
Modified server.scm from [9777f824e5] to [0c3e939ba0].
| ︙ | ︙ | |||
314 315 316 317 318 319 320 |
(thread-start! th2)
(thread-start! th3)
(set! *didsomething* #t)
(thread-join! th3))
(debug:print 0 "ERROR: Failed to setup for megatest")))
(exit)))
| > > > > > > > > > > > > > > > > > | > | | | | | | 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 |
(thread-start! th2)
(thread-start! th3)
(set! *didsomething* #t)
(thread-join! th3))
(debug:print 0 "ERROR: Failed to setup for megatest")))
(exit)))
(define (server:client-signal-handler signum)
(handle-exceptions
exn
(debug:print " ... exiting ...")
(let ((th1 (make-thread (lambda ()
(receive-message* *runremote*)) ;; flush out last call if applicable
"eat response"))
(th2 (make-thread (lambda ()
(debug:print 0 "ERROR: Received ^C, attempting clean exit.")
(thread-sleep! 3) ;; give the flush three seconds to do it's stuff
(debug:print 0 " Done.")
(exit 4))
"exit on ^C timer")))
(thread-start! th2)
(thread-start! th1)
(thread-join! th2))))
(define (server:client-launch)
(set-signal-handler! signal/int server:client-signal-handler)
(if (server:client-setup)
(debug:print-info 2 "connected as client")
(begin
(debug:print 0 "ERROR: Failed to connect as client")
(exit))))
;; ping a server and return number of clients or #f (if no response)
(define (server:ping host port #!key (secs 10)(return-socket #f))
(cdb:use-non-blocking-mode
(lambda ()
(let* ((res #f)
(th1 (make-thread
|
| ︙ | ︙ |