Megatest

Check-in [530e6e23bd]
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

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
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
		  (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)
		  ;; 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)
			(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))
		    (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))))))
		    (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)))
			  (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
			(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: 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)))))
			  (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)))
		    (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)))))))))))
		      (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