15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
|
(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)
(declare (unit client))
(declare (uses common))
(declare (uses db))
(declare (uses tasks)) ;; tasks are where stuff is maintained about what is running.
|
|
|
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
|
(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 uri-common intarweb)
(declare (unit client))
(declare (uses common))
(declare (uses db))
(declare (uses tasks)) ;; tasks are where stuff is maintained about what is running.
|
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
|
(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)))
|
|
>
>
>
>
>
>
>
>
>
|
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
|
(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))))
;; we are not doing fs any longer. let's cheat and start up a server
;; if we are falling back on fs (not 100% supported) do an about face and start a server
(if (not (equal? (args:get-arg "-transport") "fs"))
(begin
(set! *transport-type* #f)
(system (conc "megatest -list-servers | grep " megatest-version " | grep alive || megatest -server - -daemonize && sleep 3"))
(thread-sleep! 1)
(if (> numtries 0)
(client:setup numtries: (- numtries 1))))))
((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)))
|