262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
|
(else #f))
(loop (read-line) inl))))))
;; Client will call this procedure on the server via the low-level transport (http/rpc/etc) to verify its toppath matches the server's toppath.
;; A true result means client and server are associated with same megatest instance, share the same megatest.config, etc...) A false result means the client should not talk to this server.
(define (server:login toppath)
(lambda (toppath)
(set! *last-db-access* (current-seconds))
(if (equal? *toppath* toppath)
(begin
;; (debug:print-info 2 *default-log-port* "login successful")
#t)
(begin
;; (debug:print-info 2 *default-log-port* "login failed")
#f))))
(define (server:get-timeout)
(let ((tmo (configf:lookup *configdat* "server" "timeout")))
(if (and (string? tmo)
(string->number tmo))
(* 60 60 (string->number tmo))
;; (* 3 24 60 60) ;; default to three days
|
<
|
>
|
|
|
|
|
|
|
|
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
|
(else #f))
(loop (read-line) inl))))))
;; Client will call this procedure on the server via the low-level transport (http/rpc/etc) to verify its toppath matches the server's toppath.
;; A true result means client and server are associated with same megatest instance, share the same megatest.config, etc...) A false result means the client should not talk to this server.
(define (server:login toppath)
(set! *last-db-access* (current-seconds))
(BB> "server:login ours="*toppath*" theirs="toppath)
(if (equal? *toppath* toppath)
(begin
;; (debug:print-info 2 *default-log-port* "login successful")
#t)
(begin
;; (debug:print-info 2 *default-log-port* "login failed")
#f)))
(define (server:get-timeout)
(let ((tmo (configf:lookup *configdat* "server" "timeout")))
(if (and (string? tmo)
(string->number tmo))
(* 60 60 (string->number tmo))
;; (* 3 24 60 60) ;; default to three days
|