Megatest

Check-in [7a5200221d]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Added few more working calls
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | http-transport
Files: files | file ages | folders
SHA1: 7a5200221d22c85d02f752b765c35882a2ca0a2d
User & Date: matt on 2013-01-15 23:10:49
Other Links: branch diff | manifest | tags
Context
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
22:47
Basic server/client working check-in: ed470f76ce user: matt tags: http-transport
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified db.scm from [7976f66b1a] to [034ef23efd].

︙
1129
1130
1131
1132
1133
1134
1135
1136

1137
1138
1139
1140
1141
1142
1143

1129
1130
1131
1132
1133
1134
1135

1136
1137
1138
1139
1140
1141
1142
1143








-
+








  ;;  (begin
  ;;    (thread-sleep! 5) 
  ;;    (if (> numretries 0)(apply cdb:client-call serverdat qtype immediate (- numretries 1) params)))
   (let* ((client-sig  (server:get-client-signature))
	  (query-sig   (message-digest-string (md5-primitive) (conc qtype immediate params)))
	  (zdat        (db:obj->string (vector client-sig qtype immediate query-sig params (current-seconds)))) ;; (with-output-to-string (lambda ()(serialize params))))
	  )
     ;; (print "zdat=" zdat)
     (debug:print-info 11 "zdat=" zdat)
     (let* (
	  (res  #f)
	  (rawdat      (server:client-send-receive serverdat zdat))
	  (tmp         #f))
     (debug:print-info 11 "Sent " zdat ", received " rawdat)
     (set! tmp (db:string->obj rawdat))
     ;; (if (equal? query-sig (vector-ref myres 1))
︙
1281
1282
1283
1284
1285
1286
1287
1288

1289
1290
1291
1292

1293
1294
1295
1296
1297
1298
1299

1281
1282
1283
1284
1285
1286
1287

1288
1289
1290
1291

1292
1293
1294
1295
1296
1297
1298
1299








-
+



-
+








(define (db:process-queue-item db item)
  (let* ((stmt-key       (cdb:packet-get-qtype item))
	 (qry-sig        (cdb:packet-get-query-sig item))
	 (return-address (cdb:packet-get-client-sig item))
	 (params         (cdb:packet-get-params item))
	 (query          (let ((q (alist-ref stmt-key db:queries)))
			   (if q (car q) #f))))
    (debug:print-info 11 "Special queries/requests stmt-key=" stmt-key ", return-address=" return-address ", qrery=" query ", params=" params)
    (debug:print-info 11 "Special queries/requests stmt-key=" stmt-key ", return-address=" return-address ", query=" query ", params=" params)
    (cond
     (query
      (apply sqlite3:execute db query params)
      (server:reply pubsock return-address qry-sig #t #t))
      (server:reply return-address qry-sig #t #t))
     ((member stmt-key db:special-queries)
      (debug:print-info 11 "Handling special statement " stmt-key)
      (case stmt-key
	((immediate)
	 (let ((proc      (car params))
	       (remparams (cdr params)))
	   ;; we are being handed a procedure so call it
︙

Modified server.scm from [17b16fc90f] to [6281fc04c9].

︙
66
67
68
69
70
71
72
73

74
75
76
77
78
79
80

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)
        (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

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)
    (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)))))
︙

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