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.
|
|
|
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 directory-utils)
(declare (unit client))
(declare (uses common))
(declare (uses db))
(declare (uses tasks)) ;; tasks are where stuff is maintained about what is running.
|
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
|
;; client:setup
(define (client:setup #!key (numtries 50))
(if (not *toppath*)
(if (not (setup-for-run))
(begin
(debug:print 0 "ERROR: failed to find megatest.config, exiting")
(exit))))
(change-directory *toppath*) ;; This is probably NOT needed
(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)
|
|
|
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
|
;; client:setup
(define (client:setup #!key (numtries 50))
(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
(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)
|
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
|
((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))))))
;; client:signal-handler
(define (client:signal-handler signum)
(handle-exceptions
exn
(debug:print " ... exiting ...")
(let ((th1 (make-thread (lambda ()
|
|
>
|
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
((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))))
(pop-directory)))
;; client:signal-handler
(define (client:signal-handler signum)
(handle-exceptions
exn
(debug:print " ... exiting ...")
(let ((th1 (make-thread (lambda ()
|