Megatest

Diff
Login

Differences From Artifact [708190534e]:

To Artifact [d2de77aaac]:


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 #f)
  (port #f)
  (uuid #f)
  (dbfile #f)
  (uconn   #f) ;; this is the listener
  (uconn   #f) ;; this is the listener *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))
168
169
170
171
172
173
174
175
176
177



178
179

180
181
182



183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202

203
204

205
206
207
208
209
210
211
168
169
170
171
172
173
174



175
176
177


178



179
180
181
182
183
184

185
186
187
188
189
190
191
192
193
194
195
196
197
198
199

200
201

202
203
204
205
206
207
208
209







-
-
-
+
+
+
-
-
+
-
-
-
+
+
+



-















-
+

-
+







;; is it not expired? then return it
;;
;; else setup a connection
;;
;; if that fails, return '(#f "some reason") ;; NB// convert to raising an exception
;;
(define (rmt:get-conn remdat apath dbname)
  (let* ((fullname (db:dbname->path apath dbname))
	 (conn     (hash-table-ref/default (servdat-conns remdat) fullname #f)))
    (if (and conn
  (let* ((fullname (db:dbname->path apath dbname)))
    (hash-table-ref/default (servdat-conns remdat) fullname #f)))

	     (< (current-seconds) (conndat-expires conn)))
	conn
(define (rmt:drop-conn remdat apath dbname)
	#f ;; TODO - convert this to a refresh for the given db? (server could have moved)
	)))

  (let* ((fullname (db:dbname->path apath dbname)))
    (hash-table-delete! (servdat-conns remdat) fullname)))
  
(define (rmt:find-main-server uconn apath dbname)
  (let* ((pktsdir     (get-pkts-dir apath))
	 (all-srvpkts (get-all-server-pkts pktsdir *srvpktspec*))
	 ;; (dbpath      (conc apath "/" dbname))
	 (viable-srvs (get-viable-servers all-srvpkts dbname)))
    (get-the-server uconn apath viable-srvs)))


(define *connstart-mutex* (make-mutex))
(define *last-main-start* 0)

;; looks for a connection to main, returns if have and not exired
;; creates new otherwise
;; 
;; connections for other servers happens by requesting from main
;;
;; 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"))
  (let* ((fullpath (db:dbname->path apath ".db/main.db"))
	 (conns    (servdat-conns remdat))
	 (conn     (hash-table-ref/default conns fullpath #f)) ;; TODO - create call for this
	 (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 ()
			  (let* ((th1 (make-thread (lambda ()(rmt:run (get-host-name))) "non-db mode server")))
			    (thread-start! th1)
			    (thread-sleep! 1)
			    (let loop ((count 0))
			      (assert (< count 30) "FATAL: responder failed to initialize in rmt:open-main-connection")
			      (if (or (not *db-serv-info*)
223
224
225
226
227
228
229
230

231
232
233
234
235
236
237
221
222
223
224
225
226
227

228
229
230
231
232
233
234
235







-
+







      (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.")
      (hash-table-delete! conns fullpath) ;; clean up
      (rmt:drop-conn remdat apath ".db/main.db") ;; (hash-table-delete! conns fullpath) ;; clean up
      (rmt:open-main-connection remdat apath))
     (else
      ;; Below we will find or create and connect to main
      (let* ((dbname         (db:run-id->dbname #f))
	     (the-srv        (rmt:find-main-server myconn apath dbname))
	     (start-main-srv (lambda () ;; call IF there is no the-srv found
			       (mutex-lock! *connstart-mutex*)
355
356
357
358
359
360
361
362
363
364








365

366

367
368
369
370
371
372
373
353
354
355
356
357
358
359



360
361
362
363
364
365
366
367
368
369

370
371
372
373
374
375
376
377







-
-
-
+
+
+
+
+
+
+
+

+
-
+








;; 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* ((uconn    (servdat-uconn sinfo))
	   (res      (send-receive uconn (conndat-hostport cdat) cmd params))) ;; payload)))
      (if (member res '("#<unspecified>")) ;; TODO - fix this in string->sexpr
    (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)))
      ;; 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.
      #;(if (member res '("#<unspecified>")) ;; TODO - fix this in string->sexpr
	  #f
      res)
	  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
;;