Megatest

Check-in [f673524251]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:server:check-if-running should use external ping
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60
Files: files | file ages | folders
SHA1: f6735242510e707ea0696da5d9317fd9757963f1
User & Date: mrwellan on 2014-02-28 09:21:13
Other Links: branch diff | manifest | tags
Context
2014-02-28
10:21
Added retries back into the http request call check-in: ad116f6360 user: mrwellan tags: v1.60
09:21
server:check-if-running should use external ping check-in: f673524251 user: mrwellan tags: v1.60
2014-02-27
23:45
Bind to all interfaces on server, use client side ping in client check-in: 6f7799bdbb user: matt tags: v1.60
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified client.scm from [d348228595] to [ef3271835b].

︙
58
59
60
61
62
63
64

65
66
67
68
69
70

71
72
73
74
75
76
77

58
59
60
61
62
63
64
65
66
67
68
69
70

71
72
73
74
75
76
77
78








+





-
+








(define (client:setup run-id #!key (remaining-tries 10) (failed-connects 0))
  (debug:print 0 "INFO: client:setup remaining-tries=" remaining-tries)
  (if (<= remaining-tries 0)
      (begin
	(debug:print 0 "ERROR: failed to start or connect to server for run-id " run-id)
	(exit 1))
      (let ((host-info (hash-table-ref/default *runremote* run-id #f)))
	(debug:print-info 0 "client:setup host-info=" host-info ", remaining-tries=" remaining-tries)
	(if host-info
	    (let* ((iface     (car  host-info))
		   (port      (cadr host-info))
		   (start-res (http-transport:client-connect iface port))
		   ;; (ping-res  (server:ping-server run-id iface port))
		   (ping-res  (rmt:login-no-auto-client-setup server-dat run-id)))
		   (ping-res  (rmt:login-no-auto-client-setup start-res run-id)))
	      (if ping-res   ;; sucessful login?
		  (begin
		    (hash-table-set! *runremote* run-id start-res)
		    start-res)  ;; return the server info
		  (if (member remaining-tries '(3 4 6))
		      (begin    ;; login failed
			(debug:print 25 "INFO: client:setup start-res=" start-res ", run-id=" run-id ", server-dat=" host-info)
︙
86
87
88
89
90
91
92

93
94
95
96
97
98
99

87
88
89
90
91
92
93
94
95
96
97
98
99
100
101








+








			(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  (server:ping-server run-id iface port))
			 (ping-res  (rmt:login-no-auto-client-setup start-res run-id)))
		    (if start-res
︙

Modified http-transport.scm from [ddcbd18141] to [a8ea540d36].

︙
154
155
156
157
158
159
160
161
162


163
164
165
166
167
168
169

154
155
156
157
158
159
160


161
162
163
164
165
166
167
168
169








-
-
+
+








   (open-run-close tasks:server-set-interface-port 
		   tasks:open-db 
		   server-id 
		   ipaddrstr portnum)
   (debug:print 1 "INFO: Trying to start server on " ipaddrstr ":" portnum)
   ;; This starts the spiffy server
   ;; NEED WAY TO SET IP TO #f TO BIND ALL
   (start-server ;; bind-address: ipaddrstr
		 port: portnum)
   ;; (start-server bind-address: ipaddrstr port: portnum)
   (start-server port: portnum)
   (open-run-close tasks:server-force-clean-run-record tasks:open-db run-id ipaddrstr portnum " http-transport:try-start-server")
   (debug:print 1 "INFO: server has been stopped")))

;;======================================================================
;; S E R V E R   U T I L I T I E S 
;;======================================================================
︙

Modified server.scm from [978e83bfc8] to [ae3fed0a96].

︙
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

109
110
111
112
113
114
115

116
117
118
119
120
121

122
123
124

125
126
127
128
129
130
131
132








-






-
+


-
+








  (if (eq? run-id 0)
      (server:run run-id)
      (rmt:start-server run-id)))

(define (server:check-if-running run-id)
  (let loop ((server (open-run-close tasks:get-server tasks:open-db run-id))
	     (trycount 0))
    (thread-sleep! 2)
    (if server
	;; note: client:start will set *runremote*. this needs to be changed
	;;       also, client:start will login to the server, also need to change that.
	;;
	;; client:start returns #t if login was successful.
	;;
	(let ((res (client:start run-id server)))
	(let ((res (server:ping-server run-id (vector-ref server 1)(vector-ref server 0))))
	  ;; if the server didn't respond we must remove the record
	  (if res
	      res
	      #t
	      (begin
		(open-run-close tasks:server-force-clean-running-records-for-run-id tasks:open-db run-id 
				" server:check-if-running")
		res)))
	#f)))

(define (server:ping-server run-id iface port)
︙

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