Megatest

Check-in [4f1427787a]
Login
Overview
Comment:wip
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.70-captain-ulex | v1.70-defunct-try
Files: files | file ages | folders
SHA1: 4f1427787aea3081e2ad4bd8eb563196d53d2c5f
User & Date: mrwellan on 2020-01-14 13:22:35
Other Links: branch diff | manifest | tags
Context
2020-01-14
22:43
wip check-in: e858e4927e user: matt tags: v1.70-captain-ulex, v1.70-defunct-try
13:22
wip check-in: 4f1427787a user: mrwellan tags: v1.70-captain-ulex, v1.70-defunct-try
2020-01-09
22:47
wip check-in: 8c88f2ef2d user: matt tags: v1.70-captain-ulex, v1.70-defunct-try
Changes

Modified rmtmod.scm from [862159ce2e] to [a1525563eb].

80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
(define (rmt:connect alldat dbfname dbtype)
  (let* ((ulexdat    (or (alldat-ulexdat alldat)
			 (rmt:setup-ulex alldat))))
    (ulex:connect ulexdat dbfname dbtype)))

;; setup the remote calls
(define (rmt:setup-ulex alldat)
  (let* ((new-ulexdat (ulex:setup))) ;; establish connection to ulex
    (alldat-ulexdat-set! alldat new-ulexdat)
    (let ((udata (alldat-ulexdat alldat)))
      ;; register all needed procs
      (ulex:register-handler udata 'ping common:get-full-version)
      (ulex:register-handler udata 'login common:get-full-version) ;; force setup of the connection
      new-ulexdat)))

;; set up a connection to the current owner of the dbfile associated with rid
;; then send the query to that dbfile owner and wait for a response.
;;
(define (rmt:send-receive cmd rid params #!key (attemptnum 1)(area-dat #f)) ;; start attemptnum at 1 so the modulo below works as expected
  (let* ((alldat   *alldat*)
	 (areapath (alldat-areapath alldat))







|
|
<
|
|
|
|







80
81
82
83
84
85
86
87
88

89
90
91
92
93
94
95
96
97
98
99
(define (rmt:connect alldat dbfname dbtype)
  (let* ((ulexdat    (or (alldat-ulexdat alldat)
			 (rmt:setup-ulex alldat))))
    (ulex:connect ulexdat dbfname dbtype)))

;; setup the remote calls
(define (rmt:setup-ulex alldat)
  (let* ((udata (ulex:setup))) ;; establish connection to ulex
    (alldat-ulexdat-set! alldat udata)

    ;; register all needed procs
    (ulex:register-handler udata 'ping common:get-full-version)  ;; override ping with get-full-version
    (ulex:register-handler udata 'login common:get-full-version) ;; force setup of the connection
    udata))

;; set up a connection to the current owner of the dbfile associated with rid
;; then send the query to that dbfile owner and wait for a response.
;;
(define (rmt:send-receive cmd rid params #!key (attemptnum 1)(area-dat #f)) ;; start attemptnum at 1 so the modulo below works as expected
  (let* ((alldat   *alldat*)
	 (areapath (alldat-areapath alldat))

Modified ulex/ulex.scm from [67cd0573a6] to [5d5093dbc4].

65
66
67
68
69
70
71

72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
	  (udat-captain-address-set! udata ipaddr)
	  (udat-captain-host-set!    udata host)
	  (udat-captain-port-set!    udata port)
	  (udat-captain-pid-set!     udata pid)
	  (if (ping udata (conc ipaddr ":" port))
	      udata
	      (begin

		(remove-captain-pkt udata captn)
		(setup))))
	(begin
	  (setup-as-captain udata)  ;; this saves the thread to captain-thread and starts the thread
	  (setup)))
    ))

;; connect to a specific dbfile
(define (connect udata dbfname dbtype)
  udata)

(define (ping udata host-port)
  (let* ((cookie (make-cookie udata))
	 (res (send-receive udata host-port 'ping "just pinging" (conc (current-seconds)))))
    (print "got res=" res)
    (equal? res cookie)
    ))

;;======================================================================
;; network utilities
;;======================================================================








>













|
|







65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
	  (udat-captain-address-set! udata ipaddr)
	  (udat-captain-host-set!    udata host)
	  (udat-captain-port-set!    udata port)
	  (udat-captain-pid-set!     udata pid)
	  (if (ping udata (conc ipaddr ":" port))
	      udata
	      (begin
		(print "Found unreachable captain at " ipaddr ":" port ", removing pkt")
		(remove-captain-pkt udata captn)
		(setup))))
	(begin
	  (setup-as-captain udata)  ;; this saves the thread to captain-thread and starts the thread
	  (setup)))
    ))

;; connect to a specific dbfile
(define (connect udata dbfname dbtype)
  udata)

(define (ping udata host-port)
  (let* ((cookie (make-cookie udata))
	 (res (send-receive udata host-port 'ping "just pinging" (conc (current-seconds)) timeout: 1)))
    ;; (print "got res=" res)
    (equal? res cookie)
    ))

;;======================================================================
;; network utilities
;;======================================================================

308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
;;
(define (setup-as-captain udata)
  (if (start-server-find-port udata) ;; puts the server in udata
      (if (create-captain-pkt udata)
	  (let* ((th (make-thread (lambda ()
				    (ulex-handler udata)) "Captain handler")))
	    (udat-handler-thread-set! udata th)
	    (thread-start! th)
	    udata)
	  #f)
      #f))

(define (get-peer-dat udata host-port #!optional (hostname #f)(pid #f))
  (let* ((pdat (or (hash-table-ref/default (udat-outgoing-conns udata) host-port #f)
		   (handle-exceptions ;; ERROR - MAKE THIS EXCEPTION HANDLER MORE SPECIFIC
		    exn







|
<







309
310
311
312
313
314
315
316

317
318
319
320
321
322
323
;;
(define (setup-as-captain udata)
  (if (start-server-find-port udata) ;; puts the server in udata
      (if (create-captain-pkt udata)
	  (let* ((th (make-thread (lambda ()
				    (ulex-handler udata)) "Captain handler")))
	    (udat-handler-thread-set! udata th)
	    (thread-start! th))

	  #f)
      #f))

(define (get-peer-dat udata host-port #!optional (hostname #f)(pid #f))
  (let* ((pdat (or (hash-table-ref/default (udat-outgoing-conns udata) host-port #f)
		   (handle-exceptions ;; ERROR - MAKE THIS EXCEPTION HANDLER MORE SPECIFIC
		    exn
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381


382
383
384
385
386
387
388
389
	  ;;       (there is a listener for handling that)
	  )
	#f))) ;; #f means failed to connect and send

;; send a request to the given host-port and register a mailbox in udata
;; wait for the mailbox data and return it
;;
(define (send-receive udata host-port handler qrykey data #!key (hostname #f)(pid #f)(params '()))
  (let ((mbox      (make-mailbox))
	(mbox-time (current-milliseconds))
	(mboxes    (udat-mboxes udata)))
    (hash-table-set! mboxes qrykey mbox)
    (if (send udata host-port handler qrykey data hostname: hostname pid: pid params: params)
	(let* ((mbox-timeout-secs    20)
	       (mbox-timeout-result 'MBOX_TIMEOUT)
	       (res                  (mailbox-receive! mbox mbox-timeout-secs mbox-timeout-result))
	       (mbox-receive-time    (current-milliseconds)))
	  (hash-table-delete! mboxes qrykey)


	  res)
	#f))) ;; #f means failed to communicate

(define (add-to-work-queue udata peer-dat handlerkey qrykey data)
  (let ((wdat (make-work peer-dat: peer-dat handlerkey: handlerkey qrykey: qrykey data: data)))
    (if (udat-busy udata)
	(queue-add! (udat-work-queue udata) wdat)
	(process-work udata wdat)) ;; passing in wdat tells process-work to first process the passed in wdat







|





|




>
>
|







364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
	  ;;       (there is a listener for handling that)
	  )
	#f))) ;; #f means failed to connect and send

;; send a request to the given host-port and register a mailbox in udata
;; wait for the mailbox data and return it
;;
(define (send-receive udata host-port handler qrykey data #!key (hostname #f)(pid #f)(params '())(timeout 20))
  (let ((mbox      (make-mailbox))
	(mbox-time (current-milliseconds))
	(mboxes    (udat-mboxes udata)))
    (hash-table-set! mboxes qrykey mbox)
    (if (send udata host-port handler qrykey data hostname: hostname pid: pid params: params)
	(let* ((mbox-timeout-secs    timeout)
	       (mbox-timeout-result 'MBOX_TIMEOUT)
	       (res                  (mailbox-receive! mbox mbox-timeout-secs mbox-timeout-result))
	       (mbox-receive-time    (current-milliseconds)))
	  (hash-table-delete! mboxes qrykey)
	  (if (eq? res 'MBOX_TIMEOUT)
	      #f
	      res))
	#f))) ;; #f means failed to communicate

(define (add-to-work-queue udata peer-dat handlerkey qrykey data)
  (let ((wdat (make-work peer-dat: peer-dat handlerkey: handlerkey qrykey: qrykey data: data)))
    (if (udat-busy udata)
	(queue-add! (udat-work-queue udata) wdat)
	(process-work udata wdat)) ;; passing in wdat tells process-work to first process the passed in wdat