Overview
Comment: | Start adding query stats |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | query-stats |
Files: | files | file ages | folders |
SHA1: |
b703c03759bf937aca1074694d2fe946 |
User & Date: | mrwellan on 2013-02-26 08:23:54 |
Other Links: | branch diff | manifest | tags |
Context
2013-02-26
| ||
08:23 | Start adding query stats Closed-Leaf check-in: b703c03759 user: mrwellan tags: query-stats | |
2013-02-25
| ||
23:03 | Changed test(s) to support setting of TARGETHOST to better enable wal mode testing check-in: 292bf433e1 user: matt tags: trunk | |
Changes
Modified common.scm from [afd3c8c16f] to [f735fa2c21].
︙ | ︙ | |||
44 45 46 47 48 49 50 | (define *my-client-signature* #f) (define *transport-type* #f) (define *megatest-db* #f) (define *rpc:listener* #f) ;; if set up for server communication this will hold the tcp port (define *runremote* #f) ;; if set up for server communication this will hold <host port> (define *last-db-access* (current-seconds)) ;; update when db is accessed via server (define *max-cache-size* 0) | > | > | 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 | (define *my-client-signature* #f) (define *transport-type* #f) (define *megatest-db* #f) (define *rpc:listener* #f) ;; if set up for server communication this will hold the tcp port (define *runremote* #f) ;; if set up for server communication this will hold <host port> (define *last-db-access* (current-seconds)) ;; update when db is accessed via server (define *max-cache-size* 0) ;; *logged-in-clients* NOT IN USE, REMOVE? ;; (define *logged-in-clients* (make-hash-table)) (define *client-non-blocking-mode* #f) (define *server-id* #f) (define *server-info* #f) (define *time-to-exit* #f) (define *received-response* #f) (define *default-numtries* 10) (define *current-query-count* 0) (define *target* (make-hash-table)) ;; cache the target here; target is keyval1/keyval2/.../keyvalN (define *keys* (make-hash-table)) ;; cache the keys here (define *keyvals* (make-hash-table)) (define *toptest-paths* (make-hash-table)) ;; cache toptest path settings here (define *test-paths* (make-hash-table)) ;; cache test-id to test run paths here (define *test-ids* (make-hash-table)) ;; cache run-id, testname, and item-path => test-id |
︙ | ︙ |
Modified db.scm from [cd2e3d6605] to [8462cb2343].
︙ | ︙ | |||
1413 1414 1415 1416 1417 1418 1419 | (server:reply return-address qry-sig '(#f "login failed due to missing params")) ;; missing params (let ((calling-path (car params)) (calling-vers (cadr params)) (client-key (caddr params))) (if (and (equal? calling-path *toppath*) (equal? megatest-version calling-vers)) (begin | > | | 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 | (server:reply return-address qry-sig '(#f "login failed due to missing params")) ;; missing params (let ((calling-path (car params)) (calling-vers (cadr params)) (client-key (caddr params))) (if (and (equal? calling-path *toppath*) (equal? megatest-version calling-vers)) (begin ;; *logged-in-clients* NOT IN USE, REMOVE? ;; (hash-table-set! *logged-in-clients* client-key (current-seconds)) (server:reply return-address qry-sig #t '(#t "successful login"))) ;; path matches - pass! Should vet the caller at this time ... (server:reply return-address qry-sig #f (list #f (conc "Login failed due to mismatch paths: " calling-path ", " *toppath*))))))) ((flush sync) (server:reply return-address qry-sig #t 1)) ;; (length data))) ((set-verbosity) (set! *verbosity* (car params)) (server:reply return-address qry-sig #t '(#t *verbosity*))) |
︙ | ︙ |
Modified http-transport.scm from [7046de44b4] to [b22bd574ac].
︙ | ︙ | |||
29 30 31 32 33 34 35 | (include "db_records.scm") (define (http-transport:make-server-url hostport) (if (not hostport) #f (conc "http://" (car hostport) ":" (cadr hostport)))) | | | > | 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 | (include "db_records.scm") (define (http-transport:make-server-url hostport) (if (not hostport) #f (conc "http://" (car hostport) ":" (cadr hostport)))) (define *server-loop-heart-beat* (current-seconds)) (define *heartbeat-mutex* (make-mutex)) (define *query-count-mutex* (make-mutex)) ;;====================================================================== ;; S E R V E R ;;====================================================================== ;; Call this to start the actual server ;; |
︙ | ︙ | |||
83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 | '(/ "hey")) (send-response body: "hey there!\n" headers: '((content-type text/plain)))) ;; This is the /ctrl path where data is handed to the server and ;; responses ((equal? (uri-path (request-uri (current-request))) '(/ "ctrl")) (let* ((packet (db:string->obj dat)) (qtype (cdb:packet-get-qtype packet))) (debug:print-info 12 "server=> received packet=" packet) (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 ;; (set! res (open-run-close db:process-queue-item open-db packet)) | > > | 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 | '(/ "hey")) (send-response body: "hey there!\n" headers: '((content-type text/plain)))) ;; This is the /ctrl path where data is handed to the server and ;; responses ((equal? (uri-path (request-uri (current-request))) '(/ "ctrl")) (let* ((packet (db:string->obj dat)) (qtype (cdb:packet-get-qtype packet))) (debug:print-info 12 "server=> received packet=" packet) (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 ;; (set! res (open-run-close db:process-queue-item open-db packet)) |
︙ | ︙ | |||
264 265 266 267 268 269 270 | (begin (debug:print 0 "ERROR: cannot find megatest.config, exiting") (exit)))) (debug:print-info 2 "Starting the standalone server") (let ((hostinfo (open-run-close tasks:get-best-server tasks:open-db))) (debug:print 11 "http-transport:launch hostinfo=" hostinfo) (if hostinfo | | | 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 | (begin (debug:print 0 "ERROR: cannot find megatest.config, exiting") (exit)))) (debug:print-info 2 "Starting the standalone server") (let ((hostinfo (open-run-close tasks:get-best-server tasks:open-db))) (debug:print 11 "http-transport:launch hostinfo=" hostinfo) (if hostinfo (debug:print-info 2 "NOT starting new server, one is already running on " (vector-ref hostinfo 1) ":" (vector-ref hostinfo 2)) (if *toppath* (let* ((th2 (make-thread (lambda () (http-transport:run (if (args:get-arg "-server") (args:get-arg "-server") "-"))) "Server run")) (th3 (make-thread (lambda ()(http-transport:keep-running)) "Keep running")) |
︙ | ︙ |