Megatest

Diff
Login

Differences From Artifact [1fc312f537]:

To Artifact [fc2d6a4da7]:


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
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     ($ 'cmd))
  (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* ((resdat  (api:execute-requests dbstruct (vector cmd params))) ;; process the request, resdat = #( flag result )
	  (let* ((res (api:execute-requests dbstruct cmd params))) 
		 (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* "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)))
	    (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) 
	  (db:obj->string (conc "Server refused to process request server-id mismatch: " key ", " *server-id*) transport: 'http)))))
	  (sexpr->string (conc "Server refused to process request server-id mismatch: " key ", " *server-id*))))))

)