Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -1317,12 +1317,12 @@ (set! *verbosity* (car params)) (server:reply return-address qry-sig #t '(#t *verbosity*))) ((killserver) (debug:print 0 "WARNING: Server going down in 15 seconds by user request!") (open-run-close tasks:server-deregister tasks:open-db - (cadr *server-info*) - pullport: (caddr *server-info*)) + (car *runremote*) + pullport: (cadr *runremote*)) (thread-start! (make-thread (lambda ()(thread-sleep! 15)(exit)))) (server:reply return-address qry-sig #t '(#t "exit process started"))) (else ;; not a command, i.e. is a query (debug:print 0 "ERROR: Unrecognised query/command " stmt-key) (server:reply pubsock return-address qry-sig #f 'failed)))) Index: server.scm ================================================================== --- server.scm +++ server.scm @@ -84,13 +84,13 @@ (if (not (member qtype '(sync ping))) (begin (mutex-lock! *heartbeat-mutex*) (set! *last-db-access* (current-seconds)) (mutex-unlock! *heartbeat-mutex*))) - (mutex-lock! *db:process-queue-mutex*) ;; trying a mutex + ;; (mutex-lock! *db:process-queue-mutex*) ;; trying a mutex (set! res (open-run-close db:process-queue-item open-db packet)) - (mutex-unlock! *db:process-queue-mutex*) + ;; (mutex-unlock! *db:process-queue-mutex*) (debug:print-info 11 "Return value from db:process-queue-item is " res) (send-response body: (conc "ctrl data\n" res "") headers: '((content-type text/plain))))) Index: tasks.scm ================================================================== --- tasks.scm +++ tasks.scm @@ -176,11 +176,11 @@ (define (tasks:get-best-server mdb) (let ((res '()) (best #f)) (sqlite3:for-each-row (lambda (id hostname interface port pid) - (set! res (cons (list hostname interface port pid) res)) + (set! res (cons (list hostname interface port pid id) res)) (debug:print-info 2 "Found existing server " hostname ":" port " registered in db")) mdb "SELECT id,hostname,interface,port,pid FROM servers WHERE strftime('%s','now')-heartbeat < 10 AND mt_version=? ORDER BY start_time ASC LIMIT 1;" megatest-version) Index: tests/tests.scm ================================================================== --- tests/tests.scm +++ tests/tests.scm @@ -79,11 +79,11 @@ (test "setup for run" #t (begin (setup-for-run) (string? (getenv "MT_RUN_AREA_HOME")))) (test "server-register, get-best-server" #t (let ((res #f)) - (open-run-close tasks:server-register tasks:open-db 1 "bob" 1234 1235 100 'live) + (open-run-close tasks:server-register tasks:open-db 1 "bob" 1234 100 'live) (set! res (open-run-close tasks:get-best-server tasks:open-db)) (number? (cadddr res)))) (test "de-register server" #t (let ((res #f)) (open-run-close tasks:server-deregister tasks:open-db "bob" pullport: 1234) @@ -96,21 +96,18 @@ (number? (caddr dat))))) (test #f #t (let ((zmq-socket (server:client-connect (cadr hostinfo) (caddr hostinfo) - (cadddr hostinfo)))) + ;; (cadddr hostinfo) + ))) (set! *runremote* zmq-socket) - (socket? (vector-ref *runremote* 0)))) + (string? (car *runremote*)))) (test #f #t (let ((res (server:client-login *runremote*))) (car res))) -(test #f #t (socket? (vector-ref *runremote* 0))) - -;; (test #f #t (server:client-setup)) - (test #f #t (car (cdb:login *runremote* *toppath* *my-client-signature*))) ;;====================================================================== ;; C O N F I G F I L E S ;;======================================================================