Megatest

Check-in [530e6e23bd]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Simplified client:setup based on assuming that retries for communications problems are handled in the http-client module
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60
Files: files | file ages | folders
SHA1: 530e6e23bd6547abc7b87e78ae01f68e5d912f25
User & Date: matt on 2014-03-16 06:41:35
Other Links: branch diff | manifest | tags
Context
2014-03-16
20:49
Improved some exception handling to fail more gracefully check-in: ddb31b7dde user: matt tags: v1.60
06:41
Simplified client:setup based on assuming that retries for communications problems are handled in the http-client module check-in: 530e6e23bd user: matt tags: v1.60
2014-03-15
21:58
Fix server start to try harder to run on current host without using nbfake. Re-factored server:ping so can call it locally. check-in: 3a11c5512d user: matt tags: v1.60
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified client.scm from [933a52eee6] to [560f4f63e6].

︙︙
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
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

	      (if ping-res   ;; sucessful login?
		  (begin
		    (debug:print-info 0 "client:setup, ping is good using host-info=" host-info ", remaining-tries=" remaining-tries)
		    ;; Why add the close-connections here?
		    ;; (http-transport:close-connections run-id)
		    (hash-table-set! *runremote* run-id start-res)
		    start-res)  ;; return the server info
		  (if (member remaining-tries '(9 6 4 2))
		      (begin    ;; login failed
			(debug:print-info 0 "client:setup, ping is bad for start-res=" start-res " and *runremote*=" host-info)
			(http-transport:close-connections run-id)
			(hash-table-delete! *runremote* run-id)
			(open-run-close tasks:server-force-clean-run-record
			 		tasks:open-db
			 		run-id 
			 		iface
			 		port
					" client:setup (host-info=#t)")
			(if (< remaining-tries 8)
			    (thread-sleep! 5)
			    (thread-sleep! 1))
			(client:setup run-id remaining-tries: 10)) ;; (- remaining-tries 1)))
		      (begin
			(debug:print 25 "INFO: client:setup failed to connect, start-res=" start-res ", run-id=" run-id ", host-info=" host-info)
			(thread-sleep! 5)
			(client:setup run-id remaining-tries: (- remaining-tries 1))))))
	    ;; YUK: rename server-dat here
	    (let* ((server-dat (open-run-close tasks:get-server tasks:open-db run-id)))
	      (debug:print-info 0 "client:setup server-dat=" server-dat ", remaining-tries=" remaining-tries)
	      (if server-dat
		  (let* ((iface     (tasks:hostinfo-get-interface server-dat))
			 (port      (tasks:hostinfo-get-port      server-dat))
			 (start-res (http-transport:client-connect iface port))
			 (ping-res  (rmt:login-no-auto-client-setup start-res run-id)))
		    (if (and start-res
			     ping-res)
			(begin
			  (hash-table-set! *runremote* run-id start-res)
			  (debug:print-info 0 "connected to " (http-transport:server-dat-make-url start-res)))
			  start-res)
			(if (member remaining-tries '(2 5))
			    (begin    ;; login failed
			      (debug:print-info 0 "client:setup, login failed, will attempt to start server ... start-res=" start-res ", run-id=" run-id ", server-dat=" server-dat)
			      (http-transport:close-connections run-id)
			      (hash-table-delete! *runremote* run-id)
			      (open-run-close tasks:server-force-clean-run-record
					      tasks:open-db
					      run-id 
					      (tasks:hostinfo-get-interface server-dat)
					      (tasks:hostinfo-get-port      server-dat)
					      " client:setup (server-dat = #t)")
			      (thread-sleep! 2)
			      (server:try-running run-id)
			      (thread-sleep! 10) ;; give server a little time to start up
			      (client:setup run-id remaining-tries: 10)) ;; (- remaining-tries 1)))
			    (begin
			      (debug:print 25 "INFO: client:setup start-res=" start-res ", run-id=" run-id ", server-dat=" server-dat)
			      (thread-sleep! 5)
			      (client:setup run-id remaining-tries: (- remaining-tries 1)))))
		  (begin    ;; no server registered
		    (if (member remaining-tries '(2))
			(begin
			  (debug:print-info 0 "no server registered, remaining-tries=" remaining-tries ", try running client:setup again")
			  ;; (open-run-close tasks:server-clean-out-old-records-for-run-id tasks:open-db run-id " client:setup (server-dat=#f)")
			  (client:setup run-id remaining-tries: remaining-tries))
			(let ((num-available (open-run-close tasks:num-in-available-state tasks:open-db run-id)))
			  (thread-sleep! 2) 
			  (debug:print-info 0 "client:setup, no server registered, remaining-tries=" remaining-tries " num-available=" num-available)

			  (if (< num-available 2)
			      (begin
				;; (open-run-close tasks:server-clean-out-old-records-for-run-id tasks:open-db run-id " client:setup (server-dat=#f)")
				(server:try-running run-id)))
			  (thread-sleep! 10) ;; give server a little time to start up
			  (client:setup run-id remaining-tries: (- remaining-tries 1)))))))))))

;; keep this as a function to ease future 
(define (client:start run-id server-info)
  (http-transport:client-connect (tasks:hostinfo-get-interface server-info)
				 (tasks:hostinfo-get-port server-info)))

;; client:signal-handler








|
|
|
|
|
<
<
<
<
<
<
|
|
|
<
<
<
<
|












|

<
|
|
|
|
|
|
|
|
|
|
|
|
|
<
<
<
<
|

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








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





115

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

	      (if ping-res   ;; sucessful login?
		  (begin
		    (debug:print-info 0 "client:setup, ping is good using host-info=" host-info ", remaining-tries=" remaining-tries)
		    ;; Why add the close-connections here?
		    ;; (http-transport:close-connections run-id)
		    (hash-table-set! *runremote* run-id start-res)
		    start-res)  ;; return the server info
		  ;; have host info but no ping. shutdown the current connection and try again
		  (begin    ;; login failed
		    (debug:print-info 0 "client:setup, ping is bad for start-res=" start-res " and *runremote*=" host-info)
		    (http-transport:close-connections run-id)
		    (hash-table-delete! *runremote* run-id)






		    (if (< remaining-tries 8)
			(thread-sleep! 5)
			(thread-sleep! 1))




		    (client:setup run-id remaining-tries: (- remaining-tries 1)))))
	    ;; YUK: rename server-dat here
	    (let* ((server-dat (open-run-close tasks:get-server tasks:open-db run-id)))
	      (debug:print-info 0 "client:setup server-dat=" server-dat ", remaining-tries=" remaining-tries)
	      (if server-dat
		  (let* ((iface     (tasks:hostinfo-get-interface server-dat))
			 (port      (tasks:hostinfo-get-port      server-dat))
			 (start-res (http-transport:client-connect iface port))
			 (ping-res  (rmt:login-no-auto-client-setup start-res run-id)))
		    (if (and start-res
			     ping-res)
			(begin
			  (hash-table-set! *runremote* run-id start-res)
			  (debug:print-info 0 "connected to " (http-transport:server-dat-make-url start-res))
			  start-res)

			(begin    ;; login failed but have a server record, clean out the record and try again
			  (debug:print-info 0 "client:setup, login failed, will attempt to start server ... start-res=" start-res ", run-id=" run-id ", server-dat=" server-dat)
			  (http-transport:close-connections run-id)
			  (hash-table-delete! *runremote* run-id)
			  (open-run-close tasks:server-force-clean-run-record
					  tasks:open-db
					  run-id 
					  (tasks:hostinfo-get-interface server-dat)
					  (tasks:hostinfo-get-port      server-dat)
					  " client:setup (server-dat = #t)")
			  (thread-sleep! 2)
			  (server:try-running run-id)
			  (thread-sleep! 10) ;; give server a little time to start up




			  (client:setup run-id remaining-tries: (- remaining-tries 1)))))
		  (begin    ;; no server registered





		    (let ((num-available (open-run-close tasks:num-in-available-state tasks:open-db run-id)))

		      (debug:print-info 0 "client:setup, no server registered, remaining-tries=" remaining-tries " num-available=" num-available)
		      (thread-sleep! 2) 
		      (if (< num-available 2)
			  (begin
			    ;; (open-run-close tasks:server-clean-out-old-records-for-run-id tasks:open-db run-id " client:setup (server-dat=#f)")
			    (server:try-running run-id)))
		      (thread-sleep! 10) ;; give server a little time to start up
		      (client:setup run-id remaining-tries: (- remaining-tries 1))))))))))

;; keep this as a function to ease future 
(define (client:start run-id server-info)
  (http-transport:client-connect (tasks:hostinfo-get-interface server-info)
				 (tasks:hostinfo-get-port server-info)))

;; client:signal-handler
︙︙

This page was generated in about 0.122s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00