Overview
| Comment: | Added few more working calls |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | http-transport |
| Files: | files | file ages | folders |
| SHA1: |
7a5200221d22c85d02f752b765c35882 |
| User & Date: | matt on 2013-01-15 23:10:49 |
| Other Links: | branch diff | manifest | tags |
Context
|
2013-01-16
| ||
| 22:59 | trying various angles to understand why some calls fail check-in: 6fd2156085 user: matt tags: http-transport | |
|
2013-01-15
| ||
| 23:10 | Added few more working calls check-in: 7a5200221d user: matt tags: http-transport | |
| 22:47 | Basic server/client working check-in: ed470f76ce user: matt tags: http-transport | |
Changes
Modified db.scm from [7976f66b1a] to [034ef23efd].
| ︙ | ︙ | |||
1129 1130 1131 1132 1133 1134 1135 | ;; (begin ;; (thread-sleep! 5) ;; (if (> numretries 0)(apply cdb:client-call serverdat qtype immediate (- numretries 1) params))) (let* ((client-sig (server:get-client-signature)) (query-sig (message-digest-string (md5-primitive) (conc qtype immediate params))) (zdat (db:obj->string (vector client-sig qtype immediate query-sig params (current-seconds)))) ;; (with-output-to-string (lambda ()(serialize params)))) ) | | | 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 |
;; (begin
;; (thread-sleep! 5)
;; (if (> numretries 0)(apply cdb:client-call serverdat qtype immediate (- numretries 1) params)))
(let* ((client-sig (server:get-client-signature))
(query-sig (message-digest-string (md5-primitive) (conc qtype immediate params)))
(zdat (db:obj->string (vector client-sig qtype immediate query-sig params (current-seconds)))) ;; (with-output-to-string (lambda ()(serialize params))))
)
(debug:print-info 11 "zdat=" zdat)
(let* (
(res #f)
(rawdat (server:client-send-receive serverdat zdat))
(tmp #f))
(debug:print-info 11 "Sent " zdat ", received " rawdat)
(set! tmp (db:string->obj rawdat))
;; (if (equal? query-sig (vector-ref myres 1))
|
| ︙ | ︙ | |||
1281 1282 1283 1284 1285 1286 1287 | (define (db:process-queue-item db item) (let* ((stmt-key (cdb:packet-get-qtype item)) (qry-sig (cdb:packet-get-query-sig item)) (return-address (cdb:packet-get-client-sig item)) (params (cdb:packet-get-params item)) (query (let ((q (alist-ref stmt-key db:queries))) (if q (car q) #f)))) | | | | 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 |
(define (db:process-queue-item db item)
(let* ((stmt-key (cdb:packet-get-qtype item))
(qry-sig (cdb:packet-get-query-sig item))
(return-address (cdb:packet-get-client-sig item))
(params (cdb:packet-get-params item))
(query (let ((q (alist-ref stmt-key db:queries)))
(if q (car q) #f))))
(debug:print-info 11 "Special queries/requests stmt-key=" stmt-key ", return-address=" return-address ", query=" query ", params=" params)
(cond
(query
(apply sqlite3:execute db query params)
(server:reply return-address qry-sig #t #t))
((member stmt-key db:special-queries)
(debug:print-info 11 "Handling special statement " stmt-key)
(case stmt-key
((immediate)
(let ((proc (car params))
(remparams (cdr params)))
;; we are being handed a procedure so call it
|
| ︙ | ︙ |
Modified server.scm from [17b16fc90f] to [6281fc04c9].
| ︙ | ︙ | |||
66 67 68 69 70 71 72 |
(define (server:main-loop)
(print "INFO: Exectuing main server loop")
(access-log "megatest-http.log")
(server-bind-address #f)
(define-page (main-page-path)
(lambda ()
(with-request-variables (dat)
| | | 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 |
(define (server:main-loop)
(print "INFO: Exectuing main server loop")
(access-log "megatest-http.log")
(server-bind-address #f)
(define-page (main-page-path)
(lambda ()
(with-request-variables (dat)
(debug:print-info 12 "Got dat=" dat)
(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))
|
| ︙ | ︙ | |||
136 137 138 139 140 141 142 | ;; <html> ;; <head></head> ;; <body>1 Hello, world! Goodbye Dolly</body></html> ;; Send msg to serverdat and receive result (define (server:client-send-receive serverdat msg) (let* ((url (server:make-server-url serverdat)) (fullurl (conc url "/?dat=" msg))) | | | 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 |
;; <html>
;; <head></head>
;; <body>1 Hello, world! Goodbye Dolly</body></html>
;; Send msg to serverdat and receive result
(define (server:client-send-receive serverdat msg)
(let* ((url (server:make-server-url serverdat))
(fullurl (conc url "/?dat=" msg)))
(debug:print-info 11 "fullurl=" fullurl "\n")
(let* ((res (with-input-from-request fullurl #f read-string)))
(debug:print-info 11 "got res=" res)
(let ((match (string-search (regexp "<body>(.*)<.body>") res)))
(debug:print-info 11 "match=" match)
(let ((final (cadr match)))
(debug:print-info 11 "final=" final)
final)))))
|
| ︙ | ︙ |