415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
|
(hostname (if (string=? "-" hostn)
(get-host-name)
hostn))
(ipaddrstr (if (string=? "-" hostn)
(server:get-best-guess-address hostname) ;; (string-intersperse (map number->string (u8vector->list (hostname->ip hostname))) ".")
#f))
(BB> 1)
(BB> 2)
(BB> 3)
|
>
>
>
>
|
<
<
<
<
|
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
|
(hostname (if (string=? "-" hostn)
(get-host-name)
hostn))
(ipaddrstr (if (string=? "-" hostn)
(server:get-best-guess-address hostname) ;; (string-intersperse (map number->string (u8vector->list (hostname->ip hostname))) ".")
(string-intersperse
(map number->string
(u8vector->list
(hostname->ip hostn))) ".")
))
(portnum (let ((res (rpc:default-server-port))) res))
(host:port (conc (if ipaddrstr ipaddrstr hostname) ":" portnum)))
(tasks:server-set-interface-port (db:delay-if-busy (tasks:open-db)) server-id ipaddrstr portnum)
;;============================================================
;; activate thread th1 to attach opened tcp port to rpc server
;;=============================================================
(thread-start! th1)
(set! db *inmemdb*)
(debug:print 0 *default-log-port* "Server started on " host:port)
;; (thread-sleep! 5)
(if (retry-thunk (lambda ()
(rpc-transport:self-test run-id ipaddrstr portnum))
final-failure-returns-actual: #t
)
(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)
(tasks:server-set-state! (db:delay-if-busy (tasks:open-db)) server-id "dead")
(tcp-close rpc:listener) ;; gotta exit nicely and free up that tcp port
(rpc-transport:server-shutdown server-id rpc:listener)
(exit)))
(mutex-lock! *heartbeat-mutex*)
(set! *last-db-access* (current-seconds))
(mutex-unlock! *heartbeat-mutex*)
;;(on-exit (lambda ()
|
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
|
(tcp-buffer-size 0) ;; gotta do this because http-transport undoes it.
(let* ((testing-res ((rpc:procedure 'testing host port)))
(login-res ((rpc:procedure 'server:login host port) *toppath*))
(res (and login-res (equal? testing-res "Just testing"))))
(if login-res
(begin
(BB> "Self test PASS. login-res="login-res" testing-res="testing-res" *toppath*="*toppath*)
#t)
(begin
(BB> "Self test fail. login-res="login-res" testing-res="testing-res" *toppath*="*toppath*)
#f))
res))
|
|
|
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
|
(tcp-buffer-size 0) ;; gotta do this because http-transport undoes it.
(let* ((testing-res ((rpc:procedure 'testing host port)))
(login-res ((rpc:procedure 'server:login host port) *toppath*))
(res (and login-res (equal? testing-res "Just testing"))))
(if login-res
(begin
;;(BB> "Self test PASS. login-res="login-res" testing-res="testing-res" *toppath*="*toppath*)
#t)
(begin
(BB> "Self test fail. login-res="login-res" testing-res="testing-res" *toppath*="*toppath*)
#f))
res))
|