61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
|
;; can use this to run most anything at the remote
(rpc:publish-procedure!
'remote:run
(lambda (procstr . params)
(server:autoremote procstr params)))
(rpc:publish-procedure!
'serve:login
(lambda (toppath)
(set! *last-db-access* (current-seconds))
(if (equal? *toppath* toppath)
(begin
(debug:print 2 "INFO: login successful")
#t)
#f)))
|
|
|
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
|
;; can use this to run most anything at the remote
(rpc:publish-procedure!
'remote:run
(lambda (procstr . params)
(server:autoremote procstr params)))
(rpc:publish-procedure!
'server:login
(lambda (toppath)
(set! *last-db-access* (current-seconds))
(if (equal? *toppath* toppath)
(begin
(debug:print 2 "INFO: login successful")
#t)
#f)))
|
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
|
'cdb:pass-fail-counts
(lambda (test-id fail-count pass-count)
(debug:print 4 "INFO: Remote call of cdb:pass-fail-counts " test-id " passes: " pass-count " fails: " fail-count)
(cdb:pass-fail-counts test-id fail-count pass-count)))
(rpc:publish-procedure!
'cdb:tests-register-test
(lambda (run-id test-name item-path)
(debug:print 4 "INFO: Remote call of cdb:tests-register-test " run-id " testname: " test-name " item-path: " item-path)
(cdb:tests-register-test run-id test-name item-path)))
(rpc:publish-procedure!
'cdb:flush-queue
(lambda ()
(debug:print 4 "INFO: Remote call of cdb:flush-queue")
(cdb:flush-queue)))
|
|
|
|
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
|
'cdb:pass-fail-counts
(lambda (test-id fail-count pass-count)
(debug:print 4 "INFO: Remote call of cdb:pass-fail-counts " test-id " passes: " pass-count " fails: " fail-count)
(cdb:pass-fail-counts test-id fail-count pass-count)))
(rpc:publish-procedure!
'cdb:tests-register-test
(lambda (db run-id test-name item-path)
(debug:print 4 "INFO: Remote call of cdb:tests-register-test " run-id " testname: " test-name " item-path: " item-path)
(cdb:tests-register-test db run-id test-name item-path)))
(rpc:publish-procedure!
'cdb:flush-queue
(lambda ()
(debug:print 4 "INFO: Remote call of cdb:flush-queue")
(cdb:flush-queue)))
|
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
|
(debug:print 0 " EXCEPTION: " ((condition-property-accessor 'exn 'message) exn))
;; (open-run-close
;; (lambda (db . param)
;; (sqlite3:execute db "DELETE FROM metadat WHERE var='SERVER'"))
;; #f)
(set! *runremote* #f))
(if (and (not (args:get-arg "-server")) ;; no point in the server using the server using the server
((rpc:procedure 'serve:login host portn) *toppath*))
(begin
(debug:print 2 "INFO: Connected to " host ":" port)
(set! *runremote* (vector host portn)))
(begin
(debug:print 2 "INFO: Failed to connect to " host ":" port)
(set! *runremote* #f)))))
(debug:print 2 "INFO: no server available")))))
|
|
|
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
|
(debug:print 0 " EXCEPTION: " ((condition-property-accessor 'exn 'message) exn))
;; (open-run-close
;; (lambda (db . param)
;; (sqlite3:execute db "DELETE FROM metadat WHERE var='SERVER'"))
;; #f)
(set! *runremote* #f))
(if (and (not (args:get-arg "-server")) ;; no point in the server using the server using the server
((rpc:procedure 'server:login host portn) *toppath*))
(begin
(debug:print 2 "INFO: Connected to " host ":" port)
(set! *runremote* (vector host portn)))
(begin
(debug:print 2 "INFO: Failed to connect to " host ":" port)
(set! *runremote* #f)))))
(debug:print 2 "INFO: no server available")))))
|