45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
|
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
|
-
+
-
-
-
+
+
+
|
;; Call this to start the actual server
;;
;; all routes though here end in exit ...
;;
;; start_server
;;
(define (server:launch run-id)
(define (server:launch run-id area-dat)
(case *transport-type*
((http)(http-transport:launch run-id))
((nmsg)(nmsg-transport:launch run-id))
((rpc) (rpc-transport:launch run-id))
((http)(http-transport:launch run-id area-dat))
((nmsg)(nmsg-transport:launch run-id area-dat))
((rpc) (rpc-transport:launch run-id area-dat))
(else (debug:print 0 "ERROR: unknown server type " *transport-type*))))
;; (else (debug:print 0 "ERROR: No known transport set, transport=" transport ", using rpc")
;; (rpc-transport:launch run-id)))))
;;======================================================================
;; S E R V E R U T I L I T I E S
;;======================================================================
|
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
|
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
|
-
+
-
+
|
(if (eof-object? inl)
(case (string->symbol res)
((NOREPLY) #f)
((LOGIN_OK) #t)
(else #f))
(loop (read-line) inl))))))
(define (server:login toppath)
(define (server:login toppath area-dat)
(lambda (toppath)
(set! *last-db-access* (current-seconds))
(if (equal? *toppath* toppath)
(if (equal? (megatest:area-path area-dat) toppath)
(begin
;; (debug:print-info 2 "login successful")
#t)
(begin
;; (debug:print-info 2 "login failed")
#f))))
|