Index: apimod.scm ================================================================== --- apimod.scm +++ apimod.scm @@ -407,14 +407,14 @@ ;; 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))) + (params (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) + (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) @@ -424,8 +424,8 @@ (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*)))))) + (conc "Server refused to process request server signature mismatch: " key ", " *my-signature*))))) ) Index: rmtmod.scm ================================================================== --- rmtmod.scm +++ rmtmod.scm @@ -295,38 +295,39 @@ (define (rmt:send-receive-real remote apath dbname cmd params) (let* ((conn (rmt:get-conn remote apath dbname))) (assert conn "FATAL: rmt:send-receive-real called without the needed channels opened") (rmt:send-receive-setup conn) (let* ((key #f) - (payload (sexpr->string `((cmd . ,cmd) - (key . ,(rmt:conn-srvpkt conn)) - (params . ,params)))) + (payload `((cmd . ,cmd) + (key . ,(rmt:conn-srvpkt conn)) + (params . ,params))) (res (begin (write payload (rmt:conn-outport conn)) (with-input-from-port (rmt:conn-inport conn) - read-string)))) - (if (string? res) - (string->sexpr res) - res)))) + read)))) + res))) +;; (if (string? res) +;; (string->sexpr res) +;; res)))) ;; db is at apath/.db/dbname, rid is an intermediary solution and will be removed ;; sometime in the future. ;; ;; Purpose - call the main.db server and request a server be started ;; for the given area path and dbname ;; -(define (rmt:send-receive-server-start remote apath dbname) - (let* ((conn (rmt:get-conn remote apath dbname))) - (assert conn "FATAL: Unable to connect to db "apath"/"dbname) - #;(let* ((res (with-input-from-request - (rmt:conn->uri conn "api") - `((params . (,apath ,dbname))) - read-string))) - (string->sexpr res)))) +;; (define (rmt:send-receive-server-start remote apath dbname) +;; (let* ((conn (rmt:get-conn remote apath dbname))) +;; (assert conn "FATAL: Unable to connect to db "apath"/"dbname) +;; #;(let* ((res (with-input-from-request +;; (rmt:conn->uri conn "api") +;; `((params . (,apath ,dbname))) +;; read-string))) +;; (string->sexpr res)))) (define (rmt:print-db-stats) (let ((fmtstr "~40a~7-d~9-d~20,2-f")) ;; "~20,2-f" (debug:print 18 *default-log-port* "DB Stats\n========") (debug:print 18 *default-log-port* (format #f "~40a~8a~10a~10a" "Cmd" "Count" "TotTime" "Avg")) @@ -1587,24 +1588,31 @@ (servdat-status-set! *server-info* 'trying-port) (servdat-trynum-set! *server-info* (+ (servdat-trynum *server-info*) 1))) (set! *server-info* (make-servdat host: ipaddrstr port: port))) (let* ((l (rmt:try-start-server ipaddrstr port)) (dbstruct #f)) - (let-values (((i o) (tcp-accept l))) - ;; (write-line "Hello!" o) - (let loop ((indat (read i))) - (let* ((res (api:process-request dbstruct indat))) - (case res - ((quit) - (close-input-port i) - (close-output-port o)) - (else - (set! *db-last-access* (current-seconds)) - (write res o))))) - (let* ((portnum (servdat-port *server-info*))) - (portlogger:open-run-close portlogger:set-port portnum "released") - (debug:print 1 *default-log-port* "INFO: server has been stopped")))))) + (let oloop () + (let-values (((i o) (tcp-accept l))) + ;; (write-line "Hello!" o) + (let loop ((indat (read i))) + (if (eof-object? indat) + (begin + (close-input-port i) + (close-output-port o) + (oloop)) + (let* ((res (api:process-request dbstruct indat))) + (case res + ((quit) + (close-input-port i) + (close-output-port o)) + (else + (set! *db-last-access* (current-seconds)) + (write res o) + (loop (read i)))))))))) + (let* ((portnum (servdat-port *server-info*))) + (portlogger:open-run-close portlogger:set-port portnum "released") + (debug:print 1 *default-log-port* "INFO: server has been stopped")))) (define (rmt:try-start-server ipaddrstr portnum) (if *server-info* (begin (servdat-host-set! *server-info* ipaddrstr) @@ -1799,33 +1807,34 @@ (begin (write `((cmd . ping) (key . ,key) (params . ())) o) (let ((res (with-input-from-port i - read-string))) + read))) (close-output-port o) (close-input-port i) - (if (string? res) - (string->sexpr res) - res))) + res)) +;; (if (string? res) +;; (string->sexpr res) +;; res))) (begin ;; connection failed (debug:print-info 0 *default-log-port* "Server at "host":"port" is not responding.") #f)))) -(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)) - #f - ) +;; (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)) +;; #f +;; ) ; 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 ;;