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
432
433
434
435
436
437
438
439
440
|
;; api:process-request
;; db:*
;;
;; NB// Runs on the server as part of the server loop
;;
(define (api:process-request dbstruct $) ;; the $ is the request vars proc
(debug:print 0 *default-log-port* "server-id:" *server-id*)
(let* ((cmd ($ 'cmd))
(params (string->sexpr ($ 'params)))
(key ($ 'key)) ;; TODO - add this back
)
(debug:print 0 *default-log-port* "cmd:" cmd " with params " params "key " key)
(if (equal? key "nokey") ;; *server-id*) ;; TODO - get real key involved
(begin
(set! *api-process-request-count* (+ *api-process-request-count* 1))
(let* ((resdat (api:execute-requests dbstruct (vector cmd params))) ;; process the request, resdat = #( flag result )
(success (vector-ref resdat 0))
(res (vector-ref resdat 1))) ;; (vector flag payload), get the payload, ignore the flag (why?)
(debug:print 4 *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))
;; This can be here but needs controls to ensure it doesn't run more than every 4 seconds
;; (rmt:dat->json-str
;; (if (or (string? res)
;; (list? res)
;; (number? res)
;; (boolean? res))
;; res
;; (list "ERROR, not string, list, number or boolean" 1 cmd params res)))))
(db:obj->string res transport: 'http)))
(db:obj->string (conc "Server refused to process request server-id mismatch: " key ", " *server-id*) transport: 'http)))))
)
|
|
>
|
<
<
|
|
<
<
<
<
<
<
<
<
|
|
|
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
|
;; api:process-request
;; db:*
;;
;; NB// Runs on the server as part of the server loop
;;
(define (api:process-request dbstruct $) ;; the $ is the request vars proc
(debug:print 0 *default-log-port* "server-id:" *server-id*)
(let* ((cmd-in ($ 'cmd))
(cmd (if (string? cmd-in)(string->symbol cmd-in) cmd-in))
(params (string->sexpr ($ 'params)))
(key ($ 'key)) ;; TODO - add this back
)
(debug:print 0 *default-log-port* "cmd:" cmd " with params " params "key " key)
(if (equal? key "nokey") ;; *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*))))))
)
|