Megatest

Check-in [13061daea9]
Login
Overview
Comment:Full communication loop seems to be working.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65-multi-db
Files: files | file ages | folders
SHA1: 13061daea933c0ca8871abf3aa7d09a75b224706
User & Date: mrwellan on 2019-02-06 16:47:40
Other Links: branch diff | manifest | tags
Context
2019-02-06
17:00
Print out recieved/sent data at server end. check-in: bea6ae9a16 user: mrwellan tags: v1.65-multi-db
16:47
Full communication loop seems to be working. check-in: 13061daea9 user: mrwellan tags: v1.65-multi-db
15:18
Send plain text sexprs instead of pkts check-in: e69f5bdf52 user: mrwellan tags: v1.65-multi-db
Changes

Modified mtserve.scm from [1f2504af5b] to [64299a659d].

267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
(if (args:get-arg "-server")
    (let ((mode (string->symbol (args:get-arg "-server"))))
      (print "Mode: " mode)
      (case mode
	((main)(print "Starting server in main mode."))
	(else  (print "Starting server in hidden mode.")))
       ;; opens the port, drops the pkt, contacts other servers and then waits for messages
      (if (not (server:launch mode (lambda (pktrecvd)(print "Received: " pktrecvd))))
	  (exit 1))
      (set! *didsomething* #t)))

(if (args:get-arg "-repl")
    (begin
      ;; user will have to start the server manually
      (print "Run: (server:start-nmsg 'main) to start the server")







|







267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
(if (args:get-arg "-server")
    (let ((mode (string->symbol (args:get-arg "-server"))))
      (print "Mode: " mode)
      (case mode
	((main)(print "Starting server in main mode."))
	(else  (print "Starting server in hidden mode.")))
       ;; opens the port, drops the pkt, contacts other servers and then waits for messages
      (if (not (server:launch mode)) ;;  (lambda (pktrecvd)(print "Received: " pktrecvd))))
	  (exit 1))
      (set! *didsomething* #t)))

(if (args:get-arg "-repl")
    (begin
      ;; user will have to start the server manually
      (print "Run: (server:start-nmsg 'main) to start the server")

Modified nmsg-transport.scm from [6c7b845088] to [a75db0ab66].

26
27
28
29
30
31
32

33
34
35
36
37
38
39
(module
    nmsg-transport
    (
     nmsg:start-server
     nmsg:open-send-close
     nmsg:open-send-receive
     nmsg:recv

     nmsg:close
     )

(import scheme posix chicken data-structures ports)

(use nanomsg srfi-18)








>







26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
(module
    nmsg-transport
    (
     nmsg:start-server
     nmsg:open-send-close
     nmsg:open-send-receive
     nmsg:recv
     nmsg:send
     nmsg:close
     )

(import scheme posix chicken data-structures ports)

(use nanomsg srfi-18)

111
112
113
114
115
116
117

118
119
       (thread-start! th1)
       (thread-start! th2)
       (thread-join! th1)
       res))))

(define nmsg:close nn-close)
(define nmsg:recv  nn-recv)


)







>


112
113
114
115
116
117
118
119
120
121
       (thread-start! th1)
       (thread-start! th2)
       (thread-join! th1)
       res))))

(define nmsg:close nn-close)
(define nmsg:recv  nn-recv)
(define nmsg:send  nn-send)

)

Modified server.scm from [4571e1a825] to [140418ff5a].

143
144
145
146
147
148
149





150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170

171
172
173
174
175
176
177
178
179
180
181
182
183
184








185
186
187
188
189
190
191
	  ;; set all the area info in the 
	  (area-pktsdir-set! *area-info* pktdir)
	  (area-mtrah-set!   *area-info* mtdir)
	  (area-conn-set!    *area-info* area-conn)
	  (area-port-set!    *area-info* port-num)
	  (mutex-unlock! (area-mutex *area-info*))
	  area-conn))))






;; Call this to start the actual server
;;
;; start_server
;;
;;   mode: '
;;   handler: proc which takes pktrecieved as argument
;;
(define (server:launch mode proc)
  (let* ((start-time (current-seconds))
	 (rep        (server:start-nmsg mode))
	 (last-msg   (current-seconds))
	 (th1        (make-thread
		      (lambda ()
			(let loop ()
			  (let ((pktdat (server:receive rep)))
			    (set! last-msg (current-seconds))
			    ;; (print "received: " pktdat)
			    (if (not (eof-object? pktdat))
				(begin
				  (proc pktdat)

				  (loop))))))
		      "message handler"))
	 (th2       (make-thread
		     (lambda ()
		       (let loop ()
			 (thread-sleep! 10)
			 (if (> (- (current-seconds) last-msg) 60) ;; timeout after 60 seconds
			     (begin
			       (print "Waited for 60 seconds and no messages, exiting now.")
			       (exit))
			     (loop)))))))
    (thread-start! th1)
    (thread-start! th2)
    (thread-join! th1)))









(define (server:shutdown)
  (let ((conn (area-conn    *area-info*))
	(pktf (area-pktfile *area-info*))
	(port (area-port    *area-info*)))
    (if conn
	(begin







>
>
>
>
>








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



>
>
>
>
>
>
>
>







143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173

174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
	  ;; set all the area info in the 
	  (area-pktsdir-set! *area-info* pktdir)
	  (area-mtrah-set!   *area-info* mtdir)
	  (area-conn-set!    *area-info* area-conn)
	  (area-port-set!    *area-info* port-num)
	  (mutex-unlock! (area-mutex *area-info*))
	  area-conn))))

(define (server:std-handler dat)
  ;; (let* ((from-host (alist-ref 'hostname dat))
  dat)
	 

;; Call this to start the actual server
;;
;; start_server
;;
;;   mode: '
;;   handler: proc which takes pktrecieved as argument
;;
(define (server:launch mode #!optional (proc server:std-handler))
  (let* ((start-time    (current-seconds))
	 (rep           (server:start-nmsg mode))
	 (last-msg-time (current-seconds))
	 (th1           (make-thread
			 (lambda ()
			   (let loop ()
			     (let ((dat (server:receive rep)))
			       (set! last-msg-time (current-seconds))
			       ;; (print "received: " pktdat)
			       (if (not (eof-object? dat))

				   (let ((resdat (proc dat)))
				     (nmsg:send rep (with-output-to-string (lambda ()(write resdat))))
				     (loop))))))
			 "message handler"))
	 (th2           (make-thread
			 (lambda ()
			   (let loop ()
			     (thread-sleep! 10)
			     (if (> (- (current-seconds) last-msg-time) 60) ;; timeout after 60 seconds
				 (begin
				   (print "Waited for 60 seconds and no messages, exiting now.")
				   (exit))
				 (loop)))))))
    (thread-start! th1)
    (thread-start! th2)
    (thread-join! th1)))

;; get the response
;;
(define (server:receive rep)
  (let ((instr (nmsg:recv rep)))
    (if (string? instr)
	(with-input-from-string instr read)
	instr)))

(define (server:shutdown)
  (let ((conn (area-conn    *area-info*))
	(pktf (area-pktfile *area-info*))
	(port (area-port    *area-info*)))
    (if conn
	(begin
237
238
239
240
241
242
243




244

245
246

247
248
249
250



251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
    (print "msg: " msg)
    (if (and port host)
	(begin
	  (print "sending " msg " to " addr)
	  (nmsg:open-send-receive addr msg))
	#f)))





;; get the response

;;
(define (server:receive rep)

  (let ((instr (nmsg:recv rep)))
    (if (string? instr)
	(with-input-from-string instr read)
	instr)))



	 
;; is the server alive?
;;
(define (server:ping servpkt)
  (let* ((start-time (current-milliseconds))
	 (res        (server:send servpkt "ping" "t")))
    (cons (- (current-milliseconds) start-time)
	  (equal? res "got ping"))))

;; look up all pkts and get the server id (the hash), port, host/ip
;; store this info in the global struct *area-info*
;;
(define (server:get-all)
  ;; readll all pkts
  ;; foreach pkt; if it isn't me ping the server; if alive, add to hosts hash, else rm the pkt
  (let ((all-pkts (server:get-all-server-pkts *area-info*)))
    (for-each
     (lambda (servpkt)
       (let* ((res (server:ping servpkt)))
	 (print "Got " res " from server " servpkt)))
     all-pkts)))

;; send out an "I'm about to exit notice to all known servers"
;;
(define (server:imminent-death)
  '())

(define (server:get-my-best-address)
  (ip->string (car (filter (lambda (x)
			     (not (eq? (u8vector-ref x 0) 127)))
			   (vector->list (hostinfo-addresses (hostname->hostinfo "zeus")))))))

;; whoami? I am my pkt
;;
(define (server:whoami? area)
  (hash-table-ref/default (area-hosts area)(area-pktid area) #f))

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

;; get a signature for identifing this process
(define (server:get-process-signature)
  (cons (get-host-name)(current-process-id)))








>
>
>
>
|
>

|
>
|
<
<
<
>
>
>
|






|



















<
<
<
<
<
<
<
<
<









250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266



267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296









297
298
299
300
301
302
303
304
305
    (print "msg: " msg)
    (if (and port host)
	(begin
	  (print "sending " msg " to " addr)
	  (nmsg:open-send-receive addr msg))
	#f)))

(define (server:get-my-best-address)
  (ip->string (car (filter (lambda (x)
			     (not (eq? (u8vector-ref x 0) 127)))
			   (vector->list (hostinfo-addresses (hostname->hostinfo "zeus")))))))

;; whoami? I am my pkt
;;
(define (server:whoami? area)
  (hash-table-ref/default (area-hosts area)(area-pktid area) #f))




;;======================================================================
;; "Client side" operations
;;======================================================================

;; is the server alive?
;;
(define (server:ping servpkt)
  (let* ((start-time (current-milliseconds))
	 (res        (server:send servpkt "ping" "t")))
    (cons (- (current-milliseconds) start-time)
	  res))) ;; (equal? res "got ping"))))

;; look up all pkts and get the server id (the hash), port, host/ip
;; store this info in the global struct *area-info*
;;
(define (server:get-all)
  ;; readll all pkts
  ;; foreach pkt; if it isn't me ping the server; if alive, add to hosts hash, else rm the pkt
  (let ((all-pkts (server:get-all-server-pkts *area-info*)))
    (for-each
     (lambda (servpkt)
       (let* ((res (server:ping servpkt)))
	 (print "Got " res " from server " servpkt)))
     all-pkts)))

;; send out an "I'm about to exit notice to all known servers"
;;
(define (server:imminent-death)
  '())











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

;; get a signature for identifing this process
(define (server:get-process-signature)
  (cons (get-host-name)(current-process-id)))