66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
|
(define (server:main-loop)
(print "INFO: Exectuing main server loop")
(access-log "megatest-http.log")
(server-bind-address #f)
(define-page (main-page-path)
(lambda ()
(with-request-variables (dat)
(print "Got dat=" dat)
(let* ((packet (db:string->obj dat))
(qtype (cdb:packet-get-qtype packet)))
(debug:print-info 12 "server=> received packet=" packet)
(if (not (member qtype '(sync ping)))
(begin
(mutex-lock! *heartbeat-mutex*)
(set! *last-db-access* (current-seconds))
|
|
|
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
|
(define (server:main-loop)
(print "INFO: Exectuing main server loop")
(access-log "megatest-http.log")
(server-bind-address #f)
(define-page (main-page-path)
(lambda ()
(with-request-variables (dat)
(debug:print-info 12 "Got dat=" dat)
(let* ((packet (db:string->obj dat))
(qtype (cdb:packet-get-qtype packet)))
(debug:print-info 12 "server=> received packet=" packet)
(if (not (member qtype '(sync ping)))
(begin
(mutex-lock! *heartbeat-mutex*)
(set! *last-db-access* (current-seconds))
|
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
|
;; <html>
;; <head></head>
;; <body>1 Hello, world! Goodbye Dolly</body></html>
;; Send msg to serverdat and receive result
(define (server:client-send-receive serverdat msg)
(let* ((url (server:make-server-url serverdat))
(fullurl (conc url "/?dat=" msg)))
(debug:print-info 11 "fullurl=" fullurl)
(let* ((res (with-input-from-request fullurl #f read-string)))
(debug:print-info 11 "got res=" res)
(let ((match (string-search (regexp "<body>(.*)<.body>") res)))
(debug:print-info 11 "match=" match)
(let ((final (cadr match)))
(debug:print-info 11 "final=" final)
final)))))
|
|
|
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
|
;; <html>
;; <head></head>
;; <body>1 Hello, world! Goodbye Dolly</body></html>
;; Send msg to serverdat and receive result
(define (server:client-send-receive serverdat msg)
(let* ((url (server:make-server-url serverdat))
(fullurl (conc url "/?dat=" msg)))
(debug:print-info 11 "fullurl=" fullurl "\n")
(let* ((res (with-input-from-request fullurl #f read-string)))
(debug:print-info 11 "got res=" res)
(let ((match (string-search (regexp "<body>(.*)<.body>") res)))
(debug:print-info 11 "match=" match)
(let ((final (cadr match)))
(debug:print-info 11 "final=" final)
final)))))
|