Overview
| Comment: | trying various angles to understand why some calls fail |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | http-transport |
| Files: | files | file ages | folders |
| SHA1: |
6fd21560859e2bb5f0e7ae08db81a24e |
| User & Date: | matt on 2013-01-16 22:59:55 |
| Other Links: | branch diff | manifest | tags |
Context
|
2013-01-17
| ||
| 01:04 | Added basic client/server example using spiffy instead of awful check-in: 2763433f17 user: matt tags: http-transport | |
|
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 | |
Changes
Modified server.scm from [6281fc04c9] to [a4f710adb8].
| ︙ | ︙ | |||
65 66 67 68 69 70 71 |
(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 ()
| > | | > > > > > > > > > > > > > > | 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 |
(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 ()
(let ((dat ($ "dat")))
;; (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))
(mutex-unlock! *heartbeat-mutex*)))
(let ((res (open-run-close db:process-queue-item open-db packet)))
(debug:print-info 11 "Return value from db:process-queue-item is " res)
res))))))
;;; (use spiffy uri-common intarweb)
;;;
;;; (root-path "/var/www")
;;;
;;; (vhost-map `(((* any) . ,(lambda (continue)
;;; (if (equal? (uri-path (request-uri (current-request)))
;;; '(/ "hey"))
;;; (send-response body: "hey there!\n"
;;; headers: '((content-type text/plain)))
;;; (continue))))))
;;;
;;; (start-server port: 12345)
;; This is recursively run by server:run until sucessful
;;
(define (server:try-start-server ipaddrstr portnum)
(handle-exceptions
exn
(begin
|
| ︙ | ︙ | |||
135 136 137 138 139 140 141 | ;; <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)) | | | > > > > | 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 |
;; <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 url)) ;; (conc url "/?dat=" msg)))
(debug:print-info 11 "fullurl=" fullurl "\n")
(let* ((res (with-input-from-request fullurl
;; #f
;; msg
(list (cons 'dat msg))
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)))))
|
| ︙ | ︙ | |||
265 266 267 268 269 270 271 |
;; need to delete only *my* server entry (future use)
(set! *time-to-exit* #t)
(open-run-close tasks:server-deregister-self tasks:open-db (get-host-name))
(thread-sleep! 1)
(debug:print-info 0 "Max cached queries was " *max-cache-size*)
(debug:print-info 0 "Server shutdown complete. Exiting")
(exit)))))))
| < < | 284 285 286 287 288 289 290 291 292 293 294 295 296 297 |
;; need to delete only *my* server entry (future use)
(set! *time-to-exit* #t)
(open-run-close tasks:server-deregister-self tasks:open-db (get-host-name))
(thread-sleep! 1)
(debug:print-info 0 "Max cached queries was " *max-cache-size*)
(debug:print-info 0 "Server shutdown complete. Exiting")
(exit)))))))
;; all routes though here end in exit ...
(define (server:launch)
(if (not *toppath*)
(if (not (setup-for-run))
(begin
(debug:print 0 "ERROR: cannot find megatest.config, exiting")
|
| ︙ | ︙ |