357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
|
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
|
-
-
-
+
+
+
-
+
|
;; db is at apath/.db/dbname, rid is an intermediary solution and will be removed
;; sometime in the future
;;
(define (rmt:send-receive-real sinfo apath dbname cmd params)
(let* ((cdat (rmt:get-conn sinfo apath dbname)))
(assert cdat "FATAL: rmt:send-receive-real called without the needed channels opened")
(let* ((key #f)
(payload `((cmd . ,cmd)
(key . ,(conndat-srvkey cdat))
(params . ,params)))
#;(payload `(,cmd ;; (cmd . ,cmd)(key .
,(conndat-srvkey cdat)
,params))
(uconn (servdat-uconn sinfo))
(res (send-receive uconn (conndat-hostport cdat) cmd payload)))
(res (send-receive uconn (conndat-hostport cdat) cmd params))) ;; payload)))
(if (member res '("#<unspecified>")) ;; TODO - fix this in string->sexpr
#f
res))))
;; db is at apath/.db/dbname, rid is an intermediary solution and will be removed
;; sometime in the future.
;;
|
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
|
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
|
-
+
|
;; called in megatest.scm, host-port is string hostname:port
;;
;; NOTE: This is NOT called directly from clients as not all transports support a client running
;; in the same process as the server.
;;
;; conn is a conndat record
;;
(define (server:ping uconn #!key (do-exit #f))
#;(define (server:ping uconn #!key (do-exit #f))
(let* ((srvkey (conndat-srvkey uconn))
(msg (sexpr->string '(ping ,srvkey))))
(send-receive uconn 'ping msg))) ;; (server-ready? host port server-id))
;;======================================================================
;; http-transportmod.scm contents moved here
;;======================================================================
|
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
|
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
|
-
-
+
+
+
+
|
(debug:print 2 *default-log-port* "PID: "(current-process-id)". Attempting to start the server ...")
(if (and *db-serv-info*
(servdat-uconn *db-serv-info*))
(let* ((uconn (servdat-uconn *db-serv-info*)))
(wait-and-close uconn))
(let* ((port (portlogger:open-run-close portlogger:find-port))
(handler-proc (lambda (rem-host-port qrykey cmd params) ;;
(let* ((prms (alist-ref 'params params)))
(api:execute-requests *dbstruct-db* cmd prms #;params)))))
;;(let* ((prms (alist-ref 'params params)))
;; (api:execute-requests *dbstruct-db* cmd prms)))))
(assert (list? params) "FATAL: handler called with non-list params")
(api:execute-requests *dbstruct-db* cmd params))))
;; (api:process-request *dbstuct-db*
(if (not *db-serv-info*)
(set! *db-serv-info* (make-servdat host: hostn port: port)))
(let* ((uconn (run-listener handler-proc port))
(rport (udat-port uconn))) ;; the real port
(servdat-host-set! *db-serv-info* hostn)
(servdat-port-set! *db-serv-info* rport)
|
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
|
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
|
+
-
-
-
+
+
+
|
all-pkt-files)))
(define (server-address srv-pkt)
(conc (alist-ref 'host srv-pkt) ":"
(alist-ref 'port srv-pkt)))
(define (server-ready? uconn host-port key) ;; server-address is host:port
(let* ((params `((cmd . ping)(key . ,key)))
(let* ((data (sexpr->string `((cmd . ping)
(key . ,key)
(params . ()))))
|