Index: client.scm ================================================================== --- client.scm +++ client.scm @@ -75,11 +75,17 @@ ;; ;; DEBUG STUFF ;; (if (eq? *transport-type* 'fs)(begin (print "ERROR!!!!!!! refusing to run with transport " *transport-type*)(exit 99))) (debug:print-info 11 "Using transport type of " *transport-type* (if hostinfo (conc " to connect to " hostinfo) "")) (case *transport-type* - ((fs)(if (not *megatest-db*)(set! *megatest-db* (open-db)))) + ((fs) ;; (if (not *megatest-db*)(set! *megatest-db* (open-db)))) + ;; we are not doing fs any longer. let's cheat and start up a server + (set! *transport-type* #f) + (system "megatest -list-servers | grep alive || megatest -server - -daemonize && sleep 3") + (thread-sleep! 1) + (if (> numtries 0) + (client:setup numtries: (- numtries 1)))) ((http) (http-transport:client-connect (tasks:hostinfo-get-interface hostinfo) (tasks:hostinfo-get-port hostinfo))) ((zmq) (zmq-transport:client-connect (tasks:hostinfo-get-interface hostinfo) Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -1264,12 +1264,17 @@ (debug:print-info 11 "zdat=" zdat) (let* ((res #f) (rawdat (http-transport:client-send-receive serverdat zdat)) (tmp #f)) (debug:print-info 11 "Sent " zdat ", received " rawdat) - (set! tmp (db:string->obj rawdat)) - (vector-ref tmp 2)))) + (if rawdat + (begin + (set! tmp (db:string->obj rawdat)) + (vector-ref tmp 2)) + (begin + (debug:print 0 "ERROR: Communication with the server failed. Exiting if possible") + (exit 1)))))) ((zmq) (handle-exceptions exn (begin (debug:print-info 0 "cdb:client-call timeout or error. Trying again in 5 seconds") Index: http-transport.scm ================================================================== --- http-transport.scm +++ http-transport.scm @@ -162,10 +162,14 @@ ;;====================================================================== ;; C L I E N T S ;;====================================================================== +(define *http-mutex* (make-mutex)) + +;; (system "megatest -list-servers | grep alive || megatest -server - -daemonize && sleep 4") + ;; ;; ;; 1 Hello, world! Goodbye Dolly ;; Send msg to serverdat and receive result (define (http-transport:client-send-receive serverdat msg) @@ -191,17 +195,27 @@ ;; #t)) ;; send the data and get the response ;; extract the needed info from the http data and ;; process and return it. (let* ((send-recieve (lambda () + (mutex-lock! *http-mutex*) (set! res (with-input-from-request fullurl (list (cons 'dat msg)) - read-string)))) - (th1 (make-thread send-recieve "with-input-from-request"))) + read-string)) + (close-all-connections!) + (mutex-unlock! *http-mutex*))) + (time-out (lambda () + (thread-sleep! 5) + (if (not res) + (debug:print 0 "ERROR: communication with the server timed out. Exiting.")))) + (th1 (make-thread send-recieve "with-input-from-request")) + (th2 (make-thread time-out "time out"))) (thread-start! th1) + (thread-start! th2) (thread-join! th1) + (thread-terminate! th2) (debug:print-info 11 "got res=" res) (let ((match (string-search (regexp "(.*)<.body>") res))) (debug:print-info 11 "match=" match) (let ((final (cadr match))) (debug:print-info 11 "final=" final)