15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
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
| 15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
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
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
|
-
+
-
-
-
-
-
+
+
+
+
-
-
+
+
+
+
-
-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
-
-
-
-
-
+
+
+
+
+
| (require-extension (srfi 18) extras tcp s11n)
(use sqlite3 srfi-1 posix regex regex-case srfi-69 hostinfo md5 message-digest)
;; (use zmq)
(import (prefix sqlite3 sqlite3:))
(use spiffy uri-common intarweb http-client spiffy-request-vars)
(use spiffy uri-common intarweb http-client spiffy-request-vars uri-common intarweb directory-utils)
(declare (unit client))
(declare (uses common))
(declare (uses db))
(declare (uses tasks)) ;; tasks are where stuff is maintained about what is running.
(include "common_records.scm")
(include "db_records.scm")
;; client:get-signature
(define (client:get-signature)
(if *my-client-signature* *my-client-signature*
(let ((sig (conc (get-host-name) " " (current-process-id))))
(set! *my-client-signature* sig)
*my-client-signature*)))
;; client:login serverdat
(define (client:login serverdat)
(cdb:login serverdat *toppath* (client:get-signature)))
;; 2. We are a run tests, list runs or other interactive process and we mush figure out
;; 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
;;
;; lookup_server, need to remove *runremote* stuff
;;
(define (client:setup #!key (numtries 50))
(if (not *toppath*)
(define (client:setup run-id #!key (remaining-tries 100) (failed-connects 0))
(debug:print-info 2 "client:setup remaining-tries=" remaining-tries)
(let* ((tdbdat (tasks:open-db)))
(if (<= remaining-tries 0)
(if (not (setup-for-run))
(begin
(debug:print 0 "ERROR: failed to find megatest.config, exiting")
(exit))))
(debug:print-info 11 "*transport-type* is " *transport-type* ", *runremote* is " *runremote*)
(let* ((hostinfo (if (not *transport-type*) ;; If we dont' already have transport type set then figure it out
(open-run-close tasks:get-best-server tasks:open-db)
#f)))
;; if have hostinfo then extract the transport type
;; else fall back to fs
(debug:print-info 11 "CLIENT SETUP, hostinfo=" hostinfo)
(set! *transport-type* (if hostinfo
(string->symbol (tasks:hostinfo-get-transport hostinfo))
'fs))
;; ;; DEBUG STUFF
;; (if (eq? *transport-type* 'fs)(begin (print "ERROR!!!!!!! refusing to run with transport " *transport-type*)(exit 99)))
(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* " attempting to continue with fs")
(set! *transport-type* 'fs)
(set! *megatest-db* (open-db))))))
(define (client:launch)
(define (client:launch run-id)
(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))))
|