48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
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
|
;;
;; There are two scenarios.
;; 1. We are a test manager and we received *transport-type* and *runremote* via cmdline
;; 2. We are a run tests, list runs or other interactive process and we must figure out
;; *transport-type* and *runremote* from the monitor.db
;;
;; client:setup
(define (client:setup #!key (numtries 3))
(if (not *toppath*)
(if (not (setup-for-run))
(begin
(debug:print 0 "ERROR: failed to find megatest.config, exiting")
(exit))))
(push-directory *toppath*) ;; This is probably NOT needed
;; clients get the sdb:qry proc created here
;; (if (not sdb:qry)
;; (begin
;; (set! sdb:qry (make-sdb:qry (conc *toppath* "/db/strings.db"))) ;; we open the normalization helpers here
;; (sdb:qry 'setup #f)))
(debug:print-info 11 "*transport-type* is " *transport-type* ", *runremote* is " *runremote*)
(let* ((hostinfo (open-run-close tasks:get-best-server tasks:open-db)))
(debug:print-info 11 "CLIENT SETUP, hostinfo=" hostinfo)
(set! *transport-type* (if hostinfo
(string->symbol (tasks:hostinfo-get-transport hostinfo))
'fs))
(debug:print-info 11 "Using transport type of " *transport-type* (if hostinfo (conc " to connect to " hostinfo) ""))
(case *transport-type*
;; ((fs)(if (not *megatest-db*)(set! *megatest-db* (open-db))))
((http)
(http-transport:client-connect (tasks:hostinfo-get-interface hostinfo)
(tasks:hostinfo-get-port hostinfo)))
((zmq)
(zmq-transport:client-connect (tasks:hostinfo-get-interface hostinfo)
(tasks:hostinfo-get-port hostinfo)
(tasks:hostinfo-get-pubport hostinfo)))
(else ;; default to fs
(debug:print 0 "ERROR: unrecognised transport type " *transport-type* " exiting now.")
(exit)))
(pop-directory)))
;; client:signal-handler
(define (client:signal-handler signum)
(handle-exceptions
exn
(debug:print " ... exiting ...")
(let ((th1 (make-thread (lambda ()
"") ;; do nothing for now (was flush out last call if applicable)
"eat response"))
(th2 (make-thread (lambda ()
(debug:print 0 "ERROR: Received ^C, attempting clean exit. Please be patient and wait a few seconds before hitting ^C again.")
(thread-sleep! 1) ;; give the flush one second to do it's stuff
(debug:print 0 " Done.")
(exit 4))
"exit on ^C timer")))
(thread-start! th2)
(thread-start! th1)
(thread-join! th2))))
;; client:launch
(define (client:launch)
(set-signal-handler! signal/int client:signal-handler)
(if (client:setup)
(debug:print-info 2 "connected as client")
(begin
(debug:print 0 "ERROR: Failed to connect as client")
(exit))))
|
|
|
|
|
>
>
|
<
|
|
|
>
>
|
|
|
|
>
|
>
|
|
|
|
|
|
|
|
|
>
>
>
|
|
|
|
|
|
|
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
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
|
;;
;; There are two scenarios.
;; 1. We are a test manager and we received *transport-type* and *runremote* via cmdline
;; 2. We are a run tests, list runs or other interactive process and we must figure out
;; *transport-type* and *runremote* from the monitor.db
;;
;; client:setup
(define (client:setup run-id #!key (numtries 3))
(if (not *toppath*)
(if (not (setup-for-run))
(begin
(debug:print 0 "ERROR: failed to find megatest.config, exiting")
(exit))))
;; (push-directory *toppath*) ;; This is probably NOT needed
;; clients get the sdb:qry proc created here
;; (if (not sdb:qry)
;; (begin
;; (set! sdb:qry (make-sdb:qry (conc *toppath* "/db/strings.db"))) ;; we open the normalization helpers here
;; (sdb:qry 'setup #f)))
(let ((hostinfo (and run-id (hash-table-ref/default *runremote* run-id #f))))
(debug:print-info 11 "for run-id=" run-id ", *transport-type* is " *transport-type*)
(if hostinfo
hostinfo ;; have hostinfo - just return it
(let* ((hostinfo (open-run-close tasks:get-server tasks:open-db run-id))
(transport (if hostinfo
(string->symbol (tasks:hostinfo-get-transport hostinfo))
'http)))
(hash-table-set! *runremote* run-id hostinfo)
(debug:print-info 11 "CLIENT SETUP, hostinfo=" hostinfo)
(debug:print-info 11 "Using transport type of " transport (if hostinfo (conc " to connect to " hostinfo) ""))
(case *transport-type*
;; ((fs)(if (not *megatest-db*)(set! *megatest-db* (open-db))))
((http)
;; this saves the hostinfo in the *runremote* hash and returns it
(http-transport:client-connect run-id
(tasks:hostinfo-get-interface hostinfo)
(tasks:hostinfo-get-port hostinfo)))
((zmq)
(zmq-transport:client-connect (tasks:hostinfo-get-interface hostinfo)
(tasks:hostinfo-get-port hostinfo)
(tasks:hostinfo-get-pubport hostinfo)))
(else ;; default to fs
(debug:print 0 "ERROR: unrecognised transport type " *transport-type* " exiting now.")
(exit)))))))
;; (pop-directory)))
;; client:signal-handler
(define (client:signal-handler signum)
(handle-exceptions
exn
(debug:print " ... exiting ...")
(let ((th1 (make-thread (lambda ()
"") ;; do nothing for now (was flush out last call if applicable)
"eat response"))
(th2 (make-thread (lambda ()
(debug:print 0 "ERROR: Received ^C, attempting clean exit. Please be patient and wait a few seconds before hitting ^C again.")
(thread-sleep! 1) ;; give the flush one second to do it's stuff
(debug:print 0 " Done.")
(exit 4))
"exit on ^C timer")))
(thread-start! th2)
(thread-start! th1)
(thread-join! th2))))
;; client:launch
;; Need to set the signal handler somewhere other than here as this
;; routine will go away.
;;
(define (client:launch run-id)
(set-signal-handler! signal/int client:signal-handler)
(if (client:setup run-id)
(debug:print-info 2 "connected as client")
(begin
(debug:print 0 "ERROR: Failed to connect as client")
(exit))))
|