Megatest

Diff
Login

Differences From Artifact [d3535701fe]:

To Artifact [0255f4aac4]:


293
294
295
296
297
298
299
300
301
302
303
304
305
306
307

308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
;; sometime in the future
;;
(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))))
	   (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))))



;; 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: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"))
    (for-each (lambda (cmd)
		(let ((cmd-dat (hash-table-ref *db-stats* cmd)))







|
|
|




|
>
|
|
|









|
|
|
|
|
|
|
|







293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
;; sometime in the future
;;
(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 `((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))))
      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: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"))
    (for-each (lambda (cmd)
		(let ((cmd-dat (hash-table-ref *db-stats* cmd)))
1585
1586
1587
1588
1589
1590
1591

1592
1593
1594





1595
1596
1597
1598
1599
1600
1601
1602

1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
	  (servdat-host-set! *server-info* ipaddrstr)
	  (servdat-port-set! *server-info* port)
	  (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"))))))

(define (rmt:try-start-server ipaddrstr portnum)
  (if *server-info*
      (begin
	(servdat-host-set! *server-info* ipaddrstr)
	(servdat-port-set! *server-info* portnum)
	(servdat-status-set! *server-info* 'trying-port)







>
|
|
|
>
>
>
>
>
|
|
|
|
|
|
|
|
>
|
|
|







1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
	  (servdat-host-set! *server-info* ipaddrstr)
	  (servdat-port-set! *server-info* port)
	  (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 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)
	(servdat-port-set! *server-info* portnum)
	(servdat-status-set! *server-info* 'trying-port)
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806

1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826

1827
1828
1829
1830
1831
1832
1833
		      (tcp-connect host port))))
    (if (and i o)
	(begin
	  (write `((cmd . ping)
		   (key . ,key)
		   (params . ())) o)
	  (let ((res (with-input-from-port i
		       read-string)))
	    (close-output-port o)
	    (close-input-port i)

	    (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
  )

	      
; 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
;;
(define (get-viable-servers serv-pkts dbpath)
  (let loop ((tail serv-pkts)







|


>
|
|
|




|
|
|
|
|
|
|
|
|
|
|
|
<
>







1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834

1835
1836
1837
1838
1839
1840
1841
1842
		      (tcp-connect host port))))
    (if (and i o)
	(begin
	  (write `((cmd . ping)
		   (key . ,key)
		   (params . ())) o)
	  (let ((res (with-input-from-port i
		       read)))
	    (close-output-port o)
	    (close-input-port i)
	    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

;;   )
	      
; 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
;;
(define (get-viable-servers serv-pkts dbpath)
  (let loop ((tail serv-pkts)