47
48
49
50
51
52
53
54
55
56
57
58
59
60
|
dbmod
debugprint
tasksmod
servermod
matchable
)
;; allow these queries through without starting a server
;;
(define api:read-only-queries
'(get-key-val-pairs
get-var
get-keys
get-key-vals
|
>
|
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
|
dbmod
debugprint
tasksmod
servermod
matchable
)
;; allow these queries through without starting a server
;;
(define api:read-only-queries
'(get-key-val-pairs
get-var
get-keys
get-key-vals
|
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
|
;; http-server send-response
;; api:process-request
;; db:*
;;
;; NB// Runs on the server as part of the server loop
;;
(define (api:process-request dbstruct indat) ;; the $ is the request vars proc
(debug:print 0 *default-log-port* "server-id:" *server-id*)
(if (equal? key *server-id*) ;; TODO - get real key involved
(begin
(set! *api-process-request-count* (+ *api-process-request-count* 1))
(let* ((res (api:execute-requests dbstruct cmd params)))
(debug:print 0 *default-log-port* "res:" res)
#;(if (not success)
(debug:print 0 *default-log-port* "ERROR: success flag is #f for " cmd " with params " params))
(if (> *api-process-request-count* *max-api-process-requests*)
(set! *max-api-process-requests* *api-process-request-count*))
(set! *api-process-request-count* (- *api-process-request-count* 1))
(sexpr->string res)))
(begin
(debug:print 0 *default-log-port* "Server refused to process request. Sever id mismatch. recived " key " expected: " *server-id* ".\nOther arguments recived: cmd=" cmd " params = " params)
(sexpr->string (conc "Server refused to process request server-id mismatch: " key ", " *server-id*))))))
)
|
<
|
|
|
|
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
|
;; http-server send-response
;; api:process-request
;; db:*
;;
;; NB// Runs on the server as part of the server loop
;;
(define (api:process-request dbstruct indat) ;; the $ is the request vars proc
(let* ((cmd-in (alist-ref 'cmd indat)) ;; ($ 'cmd))
(cmd (if (string? cmd-in)(string->symbol cmd-in) cmd-in))
(params (string->sexpr (alist-ref 'params indat)))
(key (alist-ref 'key indat)) ;; TODO - add this back
)
(debug:print 0 *default-log-port* "cmd:" cmd " with params " params "key " key)
(if (equal? key *my-signature*) ;; TODO - get real key involved
(begin
(set! *api-process-request-count* (+ *api-process-request-count* 1))
(let* ((res (api:execute-requests dbstruct cmd params)))
(debug:print 0 *default-log-port* "res:" res)
#;(if (not success)
(debug:print 0 *default-log-port* "ERROR: success flag is #f for " cmd " with params " params))
(if (> *api-process-request-count* *max-api-process-requests*)
(set! *max-api-process-requests* *api-process-request-count*))
(set! *api-process-request-count* (- *api-process-request-count* 1))
(sexpr->string res)))
(begin
(debug:print 0 *default-log-port* "Server refused to process request. Sever id mismatch. recived " key " expected: " *my-signature* ".\nOther arguments recived: cmd=" cmd " params = " params)
(sexpr->string (conc "Server refused to process request server signature mismatch: " key ", " *my-signature*))))))
)
|