Megatest

Check-in [fb2aca7823]
Login
Overview
Comment:wip
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v2.0001-ulex-one-shot
Files: files | file ages | folders
SHA1: fb2aca7823d98a677ea7ec2bf700c2b6194178a6
User & Date: matt on 2022-01-13 06:18:32
Other Links: branch diff | manifest | tags
Context
2022-01-14
08:13
wip check-in: eccf4ded3f user: matt tags: v2.0001-ulex-one-shot
2022-01-13
22:57
Removed qrykey from some calls check-in: b40bfb8bf8 user: matt tags: v2.0001-ulex-one-shot
06:18
wip check-in: fb2aca7823 user: matt tags: v2.0001-ulex-one-shot
2022-01-12
17:49
Switched back to tcp6 check-in: 1b8dcc586b user: matt tags: v2.0001-ulex-one-shot
Changes

Modified rmtmod.scm from [c55aca3d24] to [1808890632].

115
116
117
118
119
120
121
122

123
124
125
126
127
128
129
115
116
117
118
119
120
121

122
123
124
125
126
127
128
129







-
+







;; stored (for now) in *db-serv-info*
;;
(defstruct servdat
  (host (get-host-name))
  (port #f)
  (uuid #f)
  (dbfile #f)
  (uconn   (make-udat host: (get-host-name))) ;; this is the listener *FOR THIS PROCESS*
  (uconn   (make-udat host: (get-host-name))) ;; this is the ulex record *FOR THIS PROCESS*
  (mode    #f)
  (status 'starting)
  (trynum 0) ;; count the number of ports we've tried
  (conns  (make-hash-table)) ;; apath/dbname => conndat
  ) 

(define *db-serv-info* (make-servdat))
196
197
198
199
200
201
202
203
204
205
206
207

208
209
210
211
212
213
214
215
216
217
218
196
197
198
199
200
201
202





203
204



205
206
207
208
209
210
211







-
-
-
-
-
+

-
-
-







;;
;; TODO: This is unnecessarily re-creating the record in the hash table
;;
(define (rmt:open-main-connection remdat apath)
  (let* ((fullpath (db:dbname->path apath ".db/main.db"))
	 (conns    (servdat-conns remdat))
	 (conn     (rmt:get-conn remdat apath ".db/main.db")) ;; (hash-table-ref/default conns fullpath #f)) ;; TODO - create call for this
	 (start-rmt:run (lambda ()
			  ;; (set! *db-serv-info* (make-servdat host: (get-host-name)))
			  (servdat-mode-set! *db-serv-info* 'non-db)
			  (servdat-uconn-set! *db-serv-info* (make-udat))))
	 (myconn    (servdat-uconn *db-serv-info*)))
	 (myconn   (servdat-uconn remdat)))
    (cond
     ((not *db-serv-info*) ;; myconn)
      (start-rmt:run)
      (rmt:open-main-connection remdat apath))
     ((and conn                                             ;; conn is NOT a socket, just saying ...
	   (< (current-seconds) (conndat-expires conn)))
      #t) ;; we are current and good to go - we'll deal elsewhere with a server that was killed or died 
     ((and conn
	   (>= (current-seconds)(conndat-expires conn)))
      (debug:print-info 0 *default-log-port* "connection to "fullpath" server expired. Reconnecting.")
      (rmt:drop-conn remdat apath ".db/main.db") ;;
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
229
230
231
232
233
234
235

236
237
238
239
240
241
242







-







	(if (not the-srv) ;; have server, try connecting to it
	    (start-main-srv)
	    (let* ((srv-addr (server-address the-srv)) ;; need serv
		   (ipaddr   (alist-ref 'ipaddr  the-srv))
		   (port     (alist-ref 'port    the-srv))
		   (srvkey   (alist-ref 'servkey the-srv))
		   (fullpath (db:dbname->path apath dbname))
		   
		   (new-the-srv (make-conndat
				 apath:   apath
				 dbname:  dbname
				 fullname: fullpath
				 hostport: srv-addr
				 ;; socket: (open-nn-connection srv-addr)  - TODO - open ulex connection?
				 ipaddr: ipaddr
347
348
349
350
351
352
353
354
355
356
357
358
359

360
361
362
363
364
365

366
367
368
369
370
371
372
339
340
341
342
343
344
345

346
347
348
349

350






351
352
353
354
355
356
357
358







-




-
+
-
-
-
-
-
-
+







	      (debug:print-info 0 *default-log-port* "rmt:send-receive "cmd" params="params))
	  (rmt:send-receive-real sinfo apath dbname cmd params)))))

;; 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)
  (assert (not (eq? 'primordial (thread-name (current-thread)))) "FATAL: Do not call rmt:send-receive-real in the primodial thread.")
  (let* ((cdat (rmt:get-conn sinfo apath dbname)))
    (assert cdat "FATAL: rmt:send-receive-real called without the needed channels opened")
    (let* ((uconn    (servdat-uconn sinfo)) ;; get the interface to ulex
	   ;; then send-receive using the ulex layer to host-port stored in cdat
	   (res      (send-receive uconn (conndat-hostport cdat) cmd params))
	   (res      (send-receive uconn (conndat-hostport cdat) cmd params)))
	   #;(th1      (make-thread (lambda ()
				    (set! res (send-receive uconn (conndat-hostport cdat) cmd params)))
				  "send-receive thread")))
      ;; (thread-start! th1)
      ;; (thread-join! th1)   ;; gratuitious thread stuff is so that mailbox is not used in primordial thead
      ;; since we accessed the server we can bump the expires time up
	   ;; since we accessed the server we can bump the expires time up
      (conndat-expires-set! cdat (+ (current-seconds)
				    (server:expiration-timeout)
				    -2)) ;; two second margin for network time misalignments etc.
      res)))

;; db is at apath/.db/dbname, rid is an intermediary solution and will be removed
;; sometime in the future.
1636
1637
1638
1639
1640
1641
1642

1643
1644
1645
1646
1647
1648
1649
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636







+







  (hash-table-ref/default *http-functions* fnkey (lambda () "nothing here yet")))

(define *rmt:run-mutex* (make-mutex))
(define *rmt:run-flag* #f)

;; Main entry point to start a server. was start-server
(define (rmt:run hostn)
  (assert (args:get-arg "-server") "FATAL: rmt:run called on non-server process")
  (mutex-lock! *rmt:run-mutex*)
  (if *rmt:run-flag*
      (begin
	(debug:print-warn 0 *default-log-port* "rmt:run already running.")
	(mutex-unlock! *rmt:run-mutex*))
      (begin
	(set! *rmt:run-flag* #t)

Modified ulex-simple/ulex.scm from [3a037ef6f7] to [47a35a69e2].

171
172
173
174
175
176
177





178
179

180
181
182
183
184
185
186
171
172
173
174
175
176
177
178
179
180
181
182
183

184
185
186
187
188
189
190
191







+
+
+
+
+

-
+







	  (thread-start! th1)
	  (udat-cmd-thread-set! uconn th1)
	  (print "cmd loop started")
	  uconn)
	(assert #f "ERROR: run-listener called without proper setup."))))

(define (wait-and-close uconn)
  (let loop ()
    (if (not (udat-cmd-thread uconn))
	(begin
	  (thread-sleep! 1)
	  (loop))))
  (thread-join! (udat-cmd-thread uconn))
  (tcp-close (udat-socket uconn)))
  #;(tcp-close (udat-socket uconn)))

;;======================================================================
;; peers and connections
;;======================================================================

(define *send-mutex* (make-mutex))