Index: http-transport.scm ================================================================== --- http-transport.scm +++ http-transport.scm @@ -76,10 +76,16 @@ (debug:print-info 0 "portlogger recommended port: " start-port) (root-path (if link-tree-path link-tree-path (current-directory))) ;; WARNING: SECURITY HOLE. FIX ASAP! (handle-directory spiffy-directory-listing) + (handle-exception (lambda (exn chain) + (signal (make-composite-condition + (make-property-condition + 'server + 'message "server error"))))) + ;; http-transport:handle-directory) ;; simple-directory-handler) ;; Setup the web server and a /ctrl interface ;; (vhost-map `(((* any) . ,(lambda (continue) ;; open the db on the first call Index: rmt.scm ================================================================== --- rmt.scm +++ rmt.scm @@ -141,14 +141,14 @@ (tasks:start-and-wait-for-server (db:delay-if-busy (tasks:open-db)) run-id 10) (client:setup run-id) (thread-sleep! (random 5)) ;; give some time to settle and minimize collison? (rmt:send-receive cmd rid params attemptnum: (+ attemptnum 1))) (begin - (debug:print 0 "ERROR: Communication failed!") + ;; (debug:print 0 "ERROR: Communication failed!") ;; (mutex-unlock! *send-receive-mutex*) - (exit) - ;; (rmt:open-qry-close-locally cmd run-id params)))) + ;; (exit) + (rmt:open-qry-close-locally cmd run-id params) ))))) (define (rmt:update-db-stats run-id rawcmd params duration) (mutex-lock! *db-stats-mutex*) (handle-exceptions @@ -214,11 +214,11 @@ (set! *dbstruct-db* db) db))) (db-file-path (db:dbfile-path 0))) ;; (read-only (not (file-read-access? db-file-path))) (let* ((start (current-milliseconds)) - (resdat (api:execute-requests dbstruct-local (symbol->string cmd) params)) + (resdat (api:execute-requests dbstruct-local (vector (symbol->string cmd) params))) (res (vector-ref resdat 1)) (duration (- (current-milliseconds) start))) (rmt:update-db-stats run-id cmd params duration) ;; mark this run as dirty if this was a write (if (not (member cmd api:read-only-queries)) Index: tasks.scm ================================================================== --- tasks.scm +++ tasks.scm @@ -366,11 +366,11 @@ (if (common:low-noise-print 60 run-id "server required is set") (debug:print-info 0 "Server required is set, starting server for run-id " run-id ".")) #t) ((> maxqry threshold) (if (common:low-noise-print 60 run-id "Max query time execeeded") - (debug:print-info 0 "Max avg query time of " maxqry "ms exceeds limit of " threshold "ms, starting server.")) + (debug:print-info 0 "Max avg query time of " maxqry "ms exceeds limit of " threshold "ms, server needed for run-id " run-id ".")) #t) (else #f)))) ;; try to start a server and wait for it to be available Index: tests/fullrun/megatest.config ================================================================== --- tests/fullrun/megatest.config +++ tests/fullrun/megatest.config @@ -139,15 +139,15 @@ # Three minutes is 0.05 hours # timeout 0.025 timeout 0.061 # Server is required - slower but more resistant to Sqlite issues. -required yes +# required yes # Start server when average query takes longer than this # server-query-threshold 55500 -server-query-threshold -1 +server-query-threshold 100 # daemonize yes # hostname #{scheme (get-host-name)} ## disks are: