Overview
Comment: | Decrease some noise. Added more instrumentation |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
1398d61951e2a47d3e7e8b7af6385734 |
User & Date: | matt on 2013-02-04 21:19:44 |
Other Links: | manifest | tags |
Context
2013-02-25
| ||
22:23 | wal-mode-plus-http check-in: 4b83030187 user: matt tags: trunk | |
2013-02-14
| ||
22:20 | Build system switch to chicken 4.8.0.1 Closed-Leaf check-in: 1682004561 user: matt tags: chicken-4.8.0.1 | |
2013-02-04
| ||
23:50 | re-implement transaction for sequential writes check-in: 9e0ce24da2 user: matt tags: transaction-for-sequential-writes | |
21:19 | Decrease some noise. Added more instrumentation check-in: 1398d61951 user: matt tags: trunk | |
2013-01-31
| ||
22:41 | zmq transport, registration in monitor.db fix check-in: 02ca954846 user: matt tags: trunk, This is * a % #^$@ test of tagging | |
Changes
Modified http-transport.scm from [f097187aa7] to [7046de44b4].
︙ | ︙ | |||
116 117 118 119 120 121 122 | exn (begin (print-error-message exn) (if (< portnum 9000) (begin (print "WARNING: failed to start on portnum: " portnum ", trying next port") (thread-sleep! 0.1) | | | | 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 | exn (begin (print-error-message exn) (if (< portnum 9000) (begin (print "WARNING: failed to start on portnum: " portnum ", trying next port") (thread-sleep! 0.1) ;; (open-run-close tasks:remove-server-records tasks:open-db) (http-transport:try-start-server ipaddrstr (+ portnum 1))) (print "ERROR: Tried and tried but could not start the server"))) (set! *runremote* (list ipaddrstr portnum)) ;; (open-run-close tasks:remove-server-records tasks:open-db) (open-run-close tasks:server-register tasks:open-db (current-process-id) ipaddrstr portnum 0 'live 'http) (print "INFO: Trying to start server on " ipaddrstr ":" portnum) ;; This starts the spiffy server (start-server port: portnum) |
︙ | ︙ |
Modified server.scm from [f2ac4bfe5b] to [a9e744212f].
︙ | ︙ | |||
186 187 188 189 190 191 192 | #f))) ;; if have hostinfo then extract the transport type ;; else fall back to fs (debug:print-info 11 "CLIENT SETUP, hostinfo=" hostinfo) (set! *transport-type* (if hostinfo (string->symbol (tasks:hostinfo-get-transport hostinfo)) 'fs)) | | | 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 | #f))) ;; if have hostinfo then extract the transport type ;; else fall back to fs (debug:print-info 11 "CLIENT SETUP, hostinfo=" hostinfo) (set! *transport-type* (if hostinfo (string->symbol (tasks:hostinfo-get-transport hostinfo)) 'fs)) (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)))) ((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) |
︙ | ︙ |
Modified zmq-transport.scm from [20e9358f02] to [9fdff728f3].
︙ | ︙ | |||
121 122 123 124 125 126 127 128 129 130 131 132 133 134 | ;; (debug:print-info 0 "Queue not flushed, waiting ...") ;; (loop)))))))) ;; The heavy lifting ;; ;; make-vector-record cdb packet client-sig qtype immediate query-sig params qtime ;; (let loop ((queue-lst '())) (let* ((rawmsg (receive-message* pull-socket)) (packet (db:string->obj rawmsg)) (qtype (cdb:packet-get-qtype packet))) (debug:print-info 12 "server=> received packet=" packet) (if (not (member qtype '(sync ping))) (begin | > | 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 | ;; (debug:print-info 0 "Queue not flushed, waiting ...") ;; (loop)))))))) ;; The heavy lifting ;; ;; make-vector-record cdb packet client-sig qtype immediate query-sig params qtime ;; (debug:print-info 11 "Server setup complete, start listening for messages") (let loop ((queue-lst '())) (let* ((rawmsg (receive-message* pull-socket)) (packet (db:string->obj rawmsg)) (qtype (cdb:packet-get-qtype packet))) (debug:print-info 12 "server=> received packet=" packet) (if (not (member qtype '(sync ping))) (begin |
︙ | ︙ | |||
151 152 153 154 155 156 157 158 159 160 161 162 | (let* ((server-info (let loop () (let ((sdat #f)) (mutex-lock! *heartbeat-mutex*) (set! sdat *server-info*) (mutex-unlock! *heartbeat-mutex*) (if sdat sdat (begin (sleep 4) (loop)))))) (iface (cadr server-info)) (pullport (caddr server-info)) (pubport (cadddr server-info)) ;; id interface pullport pubport) | > | > | | 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 | (let* ((server-info (let loop () (let ((sdat #f)) (mutex-lock! *heartbeat-mutex*) (set! sdat *server-info*) (mutex-unlock! *heartbeat-mutex*) (if sdat sdat (begin (debug:print 12 "WARNING: server not started yet, waiting few seconds before trying again") (sleep 4) (loop)))))) (iface (cadr server-info)) (pullport (caddr server-info)) (pubport (cadddr server-info)) ;; id interface pullport pubport) ;; (zmq-sockets (zmq-transport:client-connect iface pullport pubport)) (last-access 0)) (debug:print-info 11 "heartbeat started for zmq server on " iface " " pullport " " pubport) (let loop ((count 0)) (thread-sleep! 4) ;; no need to do this very often ;; NB// sync currently does NOT return queue-length ;; GET REAL QUEUE LENGTH FROM THE VARIABLE (let ((queue-len 0)) ;; FOR NOW DO NOT DO THIS (cdb:client-call zmq-sockets 'sync #t 1))) ;; (print "Server running, count is " count) (if (< count 1) ;; 3x3 = 9 secs aprox (loop (+ count 1))) ;; NOTE: Get rid of this mechanism! It really is not needed... (open-run-close tasks:server-update-heartbeat tasks:open-db (car server-info)) |
︙ | ︙ | |||
231 232 233 234 235 236 237 238 239 240 241 242 243 244 | tasks:open-db (current-process-id) ipaddrstr p1 0 'live 'zmq pubport: p2)) (mutex-unlock! *heartbeat-mutex*) (list s1 s2))) (define (zmq-transport:mk-signature) (message-digest-string (md5-primitive) (with-output-to-string (lambda () | > | 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 | tasks:open-db (current-process-id) ipaddrstr p1 0 'live 'zmq pubport: p2)) (debug:print-info 11 "*server-info* set to " *server-info*) (mutex-unlock! *heartbeat-mutex*) (list s1 s2))) (define (zmq-transport:mk-signature) (message-digest-string (md5-primitive) (with-output-to-string (lambda () |
︙ | ︙ |