Megatest

Check-in [da14d4a8a4]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:problems with -daemonize
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | rpc-transport
Files: files | file ages | folders
SHA1: da14d4a8a40237b8fd4fdb41e75351ca7ff29298
User & Date: bjbarcla on 2016-11-11 17:12:42
Other Links: branch diff | manifest | tags
Context
2016-11-14
15:47
removed -daemonize when starting server; removed local fallback in rmt:send-receive check-in: a31c1d5781 user: bjbarcla tags: rpc-transport
2016-11-11
17:12
problems with -daemonize check-in: da14d4a8a4 user: bjbarcla tags: rpc-transport
15:46
wip check-in: 1d35a89202 user: bjbarcla tags: rpc-transport
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified rpc-transport.scm from [af5f073564] to [5d1e126bbe].

︙︙
237
238
239
240
241
242
243











244
245
246
247
248


249
250
251
252
253
254
255
256
257
258
259
260

(define (rpc-transport:server-dat-update-last-access vec)
  (if (vector? vec)
      (vector-set! vec 5 (current-seconds))
      (begin
	(print-call-chain (current-error-port))
	(debug:print-error 0 *default-log-port* "call to rpc-transport:server-dat-update-last-access with non-vector!!"))))













;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; this client-side procedure makes rpc call to server and returns result
;;
(define (rpc-transport:client-api-send-receive run-id serverdat cmd params #!key (numretries 3))


  (let* ((iface (rpc-transport:server-dat-get-iface serverdat))
         (port  (rpc-transport:server-dat-get-port serverdat))
         (res #f)
         (run-remote (rpc:procedure 'rpc-transport:autoremote iface port))
         (api-exec (rpc:procedure 'api-exec iface port))
         (send-receive (lambda ()
                         (tcp-buffer-size 0)
                         (set! res (retry-thunk
                                    (lambda ()
                                      (condition-case
                                       ;;(vector #t (run-remote cmd params))
                                       (vector 'success (api-exec cmd params))








>
>
>
>
>
>
>
>
>
>
>





>
>



<
|








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

(define (rpc-transport:server-dat-update-last-access vec)
  (if (vector? vec)
      (vector-set! vec 5 (current-seconds))
      (begin
	(print-call-chain (current-error-port))
	(debug:print-error 0 *default-log-port* "call to rpc-transport:server-dat-update-last-access with non-vector!!"))))


(define *api-exec-ht* (make-hash-table))

;; let's see if caching the rpc stub curbs thread-profusion on server side
(define (rpc-transport:get-api-exec iface port)
  (let* ((lu (hash-table-ref/default *api-exec-ht* '(iface . port) #f)))
    (if lu
        lu
        (let ((res (rpc:procedure 'api-exec iface port)))
          (hash-table-set! *api-exec-ht* '(iface . port) res)
          res))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; this client-side procedure makes rpc call to server and returns result
;;
(define (rpc-transport:client-api-send-receive run-id serverdat cmd params #!key (numretries 3))
  (if (not (vector? serverdat))
      (BB> "WHAT?? for run-id="run-id", serverdat="serverdat))
  (let* ((iface (rpc-transport:server-dat-get-iface serverdat))
         (port  (rpc-transport:server-dat-get-port serverdat))
         (res #f)

         (api-exec (rpc-transport:get-api-exec iface port))  
         (send-receive (lambda ()
                         (tcp-buffer-size 0)
                         (set! res (retry-thunk
                                    (lambda ()
                                      (condition-case
                                       ;;(vector #t (run-remote cmd params))
                                       (vector 'success (api-exec cmd params))
︙︙
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392

    ;;=============================================================
    (thread-start! th1)
    (set! db *inmemdb*)

    (debug:print 0 *default-log-port* "Server started on " host:port)
    

    (thread-sleep! 2)
    (if (rpc-transport:self-test run-id ipaddrstr portnum)
        (debug:print 0 *default-log-port* "INFO: rpc self test passed!")
        (begin
          (debug:print 0 *default-log-port* "Error: rpc listener did not pass self test.  Shutting down.  On: " host:port)
          (exit)))
    
    (on-exit (lambda ()








|








390
391
392
393
394
395
396
397
398
399
400
401
402
403
404

    ;;=============================================================
    (thread-start! th1)
    (set! db *inmemdb*)

    (debug:print 0 *default-log-port* "Server started on " host:port)
    

    (thread-sleep! 4)
    (if (rpc-transport:self-test run-id ipaddrstr portnum)
        (debug:print 0 *default-log-port* "INFO: rpc self test passed!")
        (begin
          (debug:print 0 *default-log-port* "Error: rpc listener did not pass self test.  Shutting down.  On: " host:port)
          (exit)))
    
    (on-exit (lambda ()
︙︙
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499

                  (begin
                    (if (common:low-noise-print 120 "server continuing")
                        (debug:print-info 0 *default-log-port* "Server continuing, seconds since last db access: " (- (current-seconds) last-access)))
                    ;;
                    ;; Consider implementing some smarts here to re-insert the record or kill self is
                    ;; the db indicates so
                    ;;
                    ;; (if (tasks:server-am-i-the-server? tdb run-id)
                    ;;     (tasks:server-set-state! tdb server-id "running"))
                    ;;
                    (loop 0 bad-sync-count))
                  (begin
                    (BB> "SERVER SHUTDOWN CALLED!  last-access="last-access" current-seconds="(current-seconds)" server-timeout="server-timeout)
                    (rpc-transport:server-shutdown server-id rpc:listener)))))
          ;; end new loop
          ))))








|
|








496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511

                  (begin
                    (if (common:low-noise-print 120 "server continuing")
                        (debug:print-info 0 *default-log-port* "Server continuing, seconds since last db access: " (- (current-seconds) last-access)))
                    ;;
                    ;; Consider implementing some smarts here to re-insert the record or kill self is
                    ;; the db indicates so
                    ;;
                    (if (tasks:bb-server-am-i-the-server? run-id)
                        (tasks:bb-server-set-state! server-id "running"))
                    ;;
                    (loop 0 bad-sync-count))
                  (begin
                    (BB> "SERVER SHUTDOWN CALLED!  last-access="last-access" current-seconds="(current-seconds)" server-timeout="server-timeout)
                    (rpc-transport:server-shutdown server-id rpc:listener)))))
          ;; end new loop
          ))))
︙︙
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527

   (tcp-listen (rpc:default-server-port) 10000)
   ))
  
(define (rpc-transport:ping run-id host port)
  (handle-exceptions
   exn
   (begin
     (print "SERVER_NOT_FOUND")
     (exit 1))
   (let ((login-res ((rpc:procedure 'server:login host port) *toppath*)))
     (if login-res
	 (begin
	   (print "LOGIN_OK")
	   (exit 0))
	 (begin








|








525
526
527
528
529
530
531
532
533
534
535
536
537
538
539

   (tcp-listen (rpc:default-server-port) 10000)
   ))
  
(define (rpc-transport:ping run-id host port)
  (handle-exceptions
   exn
   (begin
     (print "SERVER_NOT_FOUND exn="exn)
     (exit 1))
   (let ((login-res ((rpc:procedure 'server:login host port) *toppath*)))
     (if login-res
	 (begin
	   (print "LOGIN_OK")
	   (exit 0))
	 (begin
︙︙

Modified server.scm from [975fdc3c54] to [6406fc4f02].

︙︙
197
198
199
200
201
202
203


204
205
206
207
208
209
210
211
212

	;; client:start returns #t if login was successful.
	;;
	(let* ((transport-type (rmt:run-id->transport-type run-id))
               (res (case transport-type
		     ((http)(server:ping-server run-id 
						(tasks:hostinfo-get-interface server)
						(tasks:hostinfo-get-port      server)))


                     ((rpc) ((rpc:procedure 'server:login (tasks:hostinfo-get-interface server) (tasks:hostinfo-get-port      server)) *toppath*))
                     
                     (else  
                      (debug:print-error 0 *default-log-port* "(5) Transport [" transport-type
                                         "] specified for run-id [" run-id
                                         "] is not implemented in rmt:send-receive.  Cannot proceed.")
                      (exit 1)))))
	  ;; if the server didn't respond we must remove the record
	  (if res








>
>
|
|








197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214

	;; client:start returns #t if login was successful.
	;;
	(let* ((transport-type (rmt:run-id->transport-type run-id))
               (res (case transport-type
		     ((http)(server:ping-server run-id 
						(tasks:hostinfo-get-interface server)
						(tasks:hostinfo-get-port      server)))
                     ((rpc) (rpc-transport:ping  run-id 
                                                 (tasks:hostinfo-get-interface server)
                                                 (tasks:hostinfo-get-port      server)))
                    
                     (else  
                      (debug:print-error 0 *default-log-port* "(5) Transport [" transport-type
                                         "] specified for run-id [" run-id
                                         "] is not implemented in rmt:send-receive.  Cannot proceed.")
                      (exit 1)))))
	  ;; if the server didn't respond we must remove the record
	  (if res
︙︙

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