Megatest

Check-in [6fd2156085]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:trying various angles to understand why some calls fail
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | http-transport
Files: files | file ages | folders
SHA1: 6fd21560859e2bb5f0e7ae08db81a24e2700e168
User & Date: matt on 2013-01-16 22:59:55
Other Links: branch diff | manifest | tags
Context
2013-01-17
01:04
Added basic client/server example using spiffy instead of awful check-in: 2763433f17 user: matt tags: http-transport
2013-01-16
22:59
trying various angles to understand why some calls fail check-in: 6fd2156085 user: matt tags: http-transport
2013-01-15
23:10
Added few more working calls check-in: 7a5200221d user: matt tags: http-transport
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified server.scm from [6281fc04c9] to [a4f710adb8].

︙
65
66
67
68
69
70
71

72

73
74
75
76
77
78
79
80
81
82



83












84
85
86
87
88
89
90

65
66
67
68
69
70
71
72

73
74
75
76
77
78
79
80
81
82

83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105








+
-
+









-
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+









(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 ()
      (let ((dat ($ "dat")))
      (with-request-variables (dat)
      ;; (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))
		(mutex-unlock! *heartbeat-mutex*)))
	  (open-run-close db:process-queue-item open-db packet))))))
	  (let ((res (open-run-close db:process-queue-item open-db packet)))
	    (debug:print-info 11 "Return value from db:process-queue-item is " res)
	    res))))))

;;; (use spiffy uri-common intarweb)
;;; 
;;; (root-path "/var/www")
;;; 
;;; (vhost-map `(((* any) . ,(lambda (continue)
;;;                            (if (equal? (uri-path (request-uri (current-request))) 
;;;                                        '(/ "hey"))
;;;                                (send-response body: "hey there!\n"
;;;                                               headers: '((content-type text/plain)))
;;;                                (continue))))))
;;; 
;;; (start-server port: 12345)

;; This is recursively run by server:run until sucessful
;;
(define (server:try-start-server ipaddrstr portnum)
  (handle-exceptions
   exn
   (begin
︙
135
136
137
138
139
140
141
142

143
144





145
146
147
148
149
150
151

150
151
152
153
154
155
156

157
158

159
160
161
162
163
164
165
166
167
168
169
170








-
+

-
+
+
+
+
+









;; <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)))
	 (fullurl url)) ;; (conc url "/?dat=" msg)))
    (debug:print-info 11 "fullurl=" fullurl "\n")
    (let* ((res   (with-input-from-request fullurl #f read-string)))
    (let* ((res   (with-input-from-request fullurl 
					   ;; #f
					   ;; msg 
					   (list (cons 'dat msg)) 
					   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)))))
︙
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280

284
285
286
287
288
289
290


291
292
293
294
295
296
297








-
-








              ;; need to delete only *my* server entry (future use)
              (set! *time-to-exit* #t)
              (open-run-close tasks:server-deregister-self tasks:open-db (get-host-name))
              (thread-sleep! 1)
              (debug:print-info 0 "Max cached queries was " *max-cache-size*)
              (debug:print-info 0 "Server shutdown complete. Exiting")
              (exit)))))))



;; all routes though here end in exit ...
(define (server:launch)
  (if (not *toppath*)
      (if (not (setup-for-run))
	  (begin
	    (debug:print 0 "ERROR: cannot find megatest.config, exiting")
︙

This page was generated in about 0.119s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00