Megatest

Check-in [444956dd03]
Login
Overview
Comment:wip
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.80-tcp-inmem
Files: files | file ages | folders
SHA1: 444956dd030f43f6e164ba3bfa733edf2833a1c2
User & Date: matt on 2023-02-12 16:39:47
Other Links: branch diff | manifest | tags
Context
2023-02-12
20:21
wip check-in: 278a10af86 user: matt tags: v1.80-tcp-inmem
16:39
wip check-in: 444956dd03 user: matt tags: v1.80-tcp-inmem
10:52
wip - start tcp/inmem check-in: 1a2eb25cb6 user: matt tags: v1.80-tcp-inmem
Changes

Modified client.scm from [6913337164] to [732bd78865].

102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
	    (match server-dat
	      ((host port start-time server-id pid)
	       (debug:print-info 4 *default-log-port* "client:setup server-dat=" server-dat ", remaining-tries=" remaining-tries)
	       (if (not runremote)
                   (begin
		     ;; Here we are creating a runremote where there was none or it was clobbered with #f
		     ;;
		     (set! runremote (make-remote))
                     (let* ((server-info (server:check-if-running areapath)))
		       (remote-server-info-set! runremote server-info)
                       (if server-info
                           (begin
                             (remote-server-url-set! runremote (server:record->url server-info))
                             (remote-server-id-set! runremote (server:record->id server-info)))))))
	       ;; at this point we have a runremote







|







102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
	    (match server-dat
	      ((host port start-time server-id pid)
	       (debug:print-info 4 *default-log-port* "client:setup server-dat=" server-dat ", remaining-tries=" remaining-tries)
	       (if (not runremote)
                   (begin
		     ;; Here we are creating a runremote where there was none or it was clobbered with #f
		     ;;
		     (set! runremote (make-and-init-remote))
                     (let* ((server-info (server:check-if-running areapath)))
		       (remote-server-info-set! runremote server-info)
                       (if server-info
                           (begin
                             (remote-server-url-set! runremote (server:record->url server-info))
                             (remote-server-id-set! runremote (server:record->id server-info)))))))
	       ;; at this point we have a runremote

Modified rmt.scm from [56f3e59ce5] to [eb5ba03d8d].

64
65
66
67
68
69
70





71
72
73
74
75
76
77
  (let* ((hh-dat (remote-hh-dat runremote)))
    (if (pair? hh-dat)
	(cdr hh-dat)
	(begin
	  (debug:print-info 0 *default-log-port* "hh-dat="hh-dat)
	  #f))))







;;======================================================================

(define *send-receive-mutex* (make-mutex)) ;; should have separate mutex per run-id

;; RA => e.g. usage (rmt:send-receive 'get-var #f (list varname))
;;







>
>
>
>
>







64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
  (let* ((hh-dat (remote-hh-dat runremote)))
    (if (pair? hh-dat)
	(cdr hh-dat)
	(begin
	  (debug:print-info 0 *default-log-port* "hh-dat="hh-dat)
	  #f))))

(define (make-and-init-remote areapath)
   (case (rmt:transport-mode)
     ((http)(make-remote))
     ((tcp) (tt:make-remote areapath))
     (else #f)))

;;======================================================================

(define *send-receive-mutex* (make-mutex)) ;; should have separate mutex per run-id

;; RA => e.g. usage (rmt:send-receive 'get-var #f (list varname))
;;
108
109
110
111
112
113
114













115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
  (let* ((start-time    (current-seconds)) ;; snapshot time so all use cases get same value
         (areapath      *toppath*);; TODO - resolve from dbstruct to be compatible with multiple areas
	 (runremote     (or area-dat
			    *runremote*))
         (attemptnum    (+ 1 attemptnum))
	 (readonly-mode (rmtmod:calc-ro-mode runremote *toppath*)))














    ;; DOT INIT_RUNREMOTE; // leaving off - doesn't really add to the clarity
    ;; DOT MUTEXLOCK -> INIT_RUNREMOTE [label="no remote?"];
    ;; DOT INIT_RUNREMOTE -> MUTEXLOCK;
    ;; ensure we have a record for our connection for given area
    (if (not runremote)                   ;; can remove this one. should never get here.         
	(begin
	  (set! *runremote* (make-remote))
          (let* ((server-info (remote-server-info *runremote*))) 
            (if server-info
		(begin
			(remote-server-url-set! *runremote* (server:record->url server-info))
			(remote-server-id-set! *runremote* (server:record->id server-info)))))  
	  (set! runremote   *runremote*))) ;; new runremote will come from this on next iteration

    (case (rmt:transport-mode)
      ((http)(http-transport-handler runremote cmd rid params attemptnum area-dat areapath readonly-mode))
      ((tcp) (tcp-transport-handler  runremote cmd rid params attemptnum area-dat areapath readonly-mode)))))

(define (http-transport-handler runremote cmd rid params attemptnum area-dat areapath readonly-mode)
  ;; DOT SET_HOMEHOST; // leaving off - doesn't really add to the clarity
  ;; DOT MUTEXLOCK -> SET_HOMEHOST [label="no homehost?"];
  ;; DOT SET_HOMEHOST -> MUTEXLOCK;
  ;; ensure we have a homehost record
  (if (or (not (pair? (remote-hh-dat runremote)))  ;; not on homehost
	  (not (cdr (remote-hh-dat runremote))))   ;; not on homehost
      (thread-sleep! 0.1) ;; since we shouldn't get here, delay a little







>
>
>
>
>
>
>
>
>
>
>
>
>






|

|





<
<
<
<
<







113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146





147
148
149
150
151
152
153
  (let* ((start-time    (current-seconds)) ;; snapshot time so all use cases get same value
         (areapath      *toppath*);; TODO - resolve from dbstruct to be compatible with multiple areas
	 (runremote     (or area-dat
			    *runremote*))
         (attemptnum    (+ 1 attemptnum))
	 (readonly-mode (rmtmod:calc-ro-mode runremote *toppath*)))

    (case (rmt:transport-mode)
      ((http)(http-transport-handler runremote cmd rid params attemptnum area-dat areapath readonly-mode))
      ((tcp) (tcp-transport-handler  runremote cmd rid params attemptnum area-dat areapath readonly-mode)))))

(define (tcp-transport-handler runremote cmd rid params attemptnum area-dat areapath readonly-mode)
  (if (not runremote)
      (let* ((newremote  (make-and-init-remote)))
	(set! *runremote* newremote)
	(set! runremote newremote)))
  (let* ((dbfname (conc (dbfile:run-id->dbnum run-id)".db"))) ;;(dbfile:run-id->path areapath run-id)))
    (tt:handler runremote cmd rid params attemptnum area-dat areapath readonly-mode dbfname)))
	
(define (http-transport-handler runremote cmd rid params attemptnum area-dat areapath readonly-mode)
    ;; DOT INIT_RUNREMOTE; // leaving off - doesn't really add to the clarity
    ;; DOT MUTEXLOCK -> INIT_RUNREMOTE [label="no remote?"];
    ;; DOT INIT_RUNREMOTE -> MUTEXLOCK;
    ;; ensure we have a record for our connection for given area
    (if (not runremote)                   ;; can remove this one. should never get here.         
	(begin
	  (set! *runremote* (make-and-init-remote areapath))
          (let* ((server-info (remote-server-info *runremote*))) 
           (if server-info
		(begin
			(remote-server-url-set! *runremote* (server:record->url server-info))
			(remote-server-id-set! *runremote* (server:record->id server-info)))))  
	  (set! runremote   *runremote*))) ;; new runremote will come from this on next iteration






  ;; DOT SET_HOMEHOST; // leaving off - doesn't really add to the clarity
  ;; DOT MUTEXLOCK -> SET_HOMEHOST [label="no homehost?"];
  ;; DOT SET_HOMEHOST -> MUTEXLOCK;
  ;; ensure we have a homehost record
  (if (or (not (pair? (remote-hh-dat runremote)))  ;; not on homehost
	  (not (cdr (remote-hh-dat runremote))))   ;; not on homehost
      (thread-sleep! 0.1) ;; since we shouldn't get here, delay a little

Modified server.scm from [1c00c07593] to [7750b95739].

674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
			    (list (car slst)(string->number (cadr slst)))
			    #f)))
		     (else
		      #f))))
    (cond
     ((and (list? host-port)
	   (eq? (length host-port) 2))
      (let* ((myrunremote (make-remote))
	     (iface       (car host-port))
	     (port        (cadr host-port))
	     (server-dat  (client:connect iface port server-id myrunremote))
	     (login-res   (rmt:login-no-auto-client-setup myrunremote)))
	(http-transport:close-connections myrunremote)
	(if (and (list? login-res)
		 (car login-res))







|







674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
			    (list (car slst)(string->number (cadr slst)))
			    #f)))
		     (else
		      #f))))
    (cond
     ((and (list? host-port)
	   (eq? (length host-port) 2))
      (let* ((myrunremote (make-and-init-remote *toppath*))
	     (iface       (car host-port))
	     (port        (cadr host-port))
	     (server-dat  (client:connect iface port server-id myrunremote))
	     (login-res   (rmt:login-no-auto-client-setup myrunremote)))
	(http-transport:close-connections myrunremote)
	(if (and (list? login-res)
		 (car login-res))

Modified tcp-transportmod.scm from [1b6d5ad8f5] to [43c7c98ef5].

37
38
39
40
41
42
43




44
45
46
47
48

49
50
51



























52
53
54
55
56
57
58
59




60
61
62









63
64
65
66
67
68
69
	stack
	files
	ports

	commonmod
	;; debugprint
	)





;; (define keep-age-param (make-parameter 10)) ;; qif file age, if over move to attic

(defstruct tt
  (area #f)

  
  )




























(define (tt:bid-for-servership run-id)
  #f)

(define (tt:get-current-server run-id)
  #f)

(define (tt:send-receive ttdat run-id cmd params)
  #f)





(define (tt:sync-dbs ttdat)
  #f)










(define (tt:shutdown-server ttdat)
  #f)



)







>
>
>
>





>



>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>






|

>
>
>
>



>
>
>
>
>
>
>
>
>







37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
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
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
	stack
	files
	ports

	commonmod
	;; debugprint
	)

;;======================================================================
;; client
;;======================================================================

;; (define keep-age-param (make-parameter 10)) ;; qif file age, if over move to attic

(defstruct tt
  (area #f)
  (conns (make-hash-table)) ;; dbfname -> conn
  
  )

(define (tt:make-remote areapath)
  (make-tt area: areapath))

(define (tt:handler runremote cmd rid params attemptnum area-dat areapath readonly-mode dbfname)
  ;; NOTE: areapath is passed in and in tt struct. We'll use passed in value for now.
  (let* ((conn (hash-table-ref/default (tt-conns runremote) dbfname #f)))
    (if conn
	;; have connection, call the server
	(let* ((res (tt:send-receive runremote conn cmd rid params)))
	  (cond
	   ((member res '(busy starting))
	    (thread-sleep! 1)
	    (tt:handler  runremote cmd rid params attemptnum area-dat areapath readonly-mode dbfname))
	   (else
	    res)))
	;; no conn yet, find and or start and find a server
	(let* ((server (tt:find-server areapath dbfname)))
	  (if server
	      (let* ((conn (tt:server-connect server)))
		(hash-table-set! (tt-conns runremote) dbfname conn)
		(tt:handler  runremote cmd rid params attemptnum area-dat areapath readonly-mode dbfname))
	      ;; no server, try to start one
	      (begin
		(tt:start-server areapath dbfname)
		(thread-sleep! 1)
		(tt:handler  runremote cmd rid params attemptnum area-dat areapath readonly-mode dbfname)))))))

(define (tt:bid-for-servership run-id)
  #f)

(define (tt:get-current-server run-id)
  #f)

(define (tt:send-receive ttdat conn cmd run-id params)
  #f)

;;======================================================================
;; server
;;======================================================================

(define (tt:sync-dbs ttdat)
  #f)

(define (tt:start-server ttdat)
  #f)

(define (tt:server-connect ttdat)
  #f)

(define (tt:find-server ttdat)
  #f)

(define (tt:shutdown-server ttdat)
  #f)



)