124
125
126
127
128
129
130
131
132
133
134
135
136
137
|
;; NOTE: http-transport:launch is the entry point
;; -> http-transport:run
;; -> http-transport:try-start-server -> http-transport:try-start-server (until success)
(define (http-get-function fnkey)
(hash-table-ref/default *http-functions* fnkey (lambda () "nothing here yet")))
(define (http-transport:run hostn)
;; Configurations for server
(tcp-buffer-size 2048)
(max-connections 2048)
(debug:print 2 *default-log-port* "Attempting to start the server ...")
(let* ((db #f) ;; (open-db)) ;; we don't want the server to be opening and closing the db unnecesarily
|
>
>
>
>
>
|
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
|
;; NOTE: http-transport:launch is the entry point
;; -> http-transport:run
;; -> http-transport:try-start-server -> http-transport:try-start-server (until success)
(define (http-get-function fnkey)
(hash-table-ref/default *http-functions* fnkey (lambda () "nothing here yet")))
(define (http-handle-api dbstruct $)
(if (api-proc)
((api-proc) dbstruct $) ;; ($) => alist
'no-api-proc-set))
(define (http-transport:run hostn)
;; Configurations for server
(tcp-buffer-size 2048)
(max-connections 2048)
(debug:print 2 *default-log-port* "Attempting to start the server ...")
(let* ((db #f) ;; (open-db)) ;; we don't want the server to be opening and closing the db unnecesarily
|
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
|
;; Setup the web server and a /ctrl interface
;;
(vhost-map `(((* any) . ,(lambda (continue)
;; open the db on the first call
;; This is were we set up the database connections
(let* (($ (request-vars source: 'both))
(dat ($ 'dat))
(res #f))
(cond
((equal? (uri-path (request-uri (current-request)))
'(/ "api"))
(debug:print 0 *default-log-port* "In api request $=" $)
(send-response ;; the $ is the request vars proc
body: ((api-proc) *dbstruct-db* $) ;; ($) => alist
headers: '((content-type text/plain)))
(set! *db-last-access* (current-seconds)))
((equal? (uri-path (request-uri (current-request)))
'(/ "ping"))
(send-response body: (conc *toppath*"/"(args:get-arg "-db"))
headers: '((content-type text/plain))))
((equal? (uri-path (request-uri (current-request)))
|
|
|
|
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
|
;; Setup the web server and a /ctrl interface
;;
(vhost-map `(((* any) . ,(lambda (continue)
;; open the db on the first call
;; This is were we set up the database connections
(let* (($ (request-vars source: 'both))
;; (dat ($ 'dat))
(res #f))
(cond
((equal? (uri-path (request-uri (current-request)))
'(/ "api"))
(debug:print 0 *default-log-port* "In api request $=" $)
(send-response ;; the $ is the request vars proc
body: (http-handle-api *dbstruct-db* $)
headers: '((content-type text/plain)))
(set! *db-last-access* (current-seconds)))
((equal? (uri-path (request-uri (current-request)))
'(/ "ping"))
(send-response body: (conc *toppath*"/"(args:get-arg "-db"))
headers: '((content-type text/plain))))
((equal? (uri-path (request-uri (current-request)))
|
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
|
(define (loop-test host port data) ;; server-address is host:port
;; ping the server and ask it
;; if it ready
;; (let* ((sdat (servdat-init #f host port #f)))
;; (http-transport:send-receive sdat "abc" 'ping '())))
(let* ((payload (sexpr->string data))
(res (with-input-from-request
(conc "http://"host":"port"/loop-test") ;; returns *toppath*/dbname
`((data . ,payload))
read-string)))
(string->sexpr res)))
; from the pkts return servers associated with dbpath
;; NOTE: Only one can be alive - have to check on each
;; in the list of pkts returned
|
|
|
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
|
(define (loop-test host port data) ;; server-address is host:port
;; ping the server and ask it
;; if it ready
;; (let* ((sdat (servdat-init #f host port #f)))
;; (http-transport:send-receive sdat "abc" 'ping '())))
(let* ((payload (sexpr->string data))
(res (with-input-from-request
(conc "http://"host":"port"/loop-test")
`((data . ,payload))
read-string)))
(string->sexpr res)))
; from the pkts return servers associated with dbpath
;; NOTE: Only one can be alive - have to check on each
;; in the list of pkts returned
|