Megatest

Check-in [d294210580]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Got http-server running clean against test1
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | http-transport
Files: files | file ages | folders
SHA1: d29421058042b1fdd29d488bc92174f8cec56b77
User & Date: matt on 2013-01-25 23:55:50
Other Links: branch diff | manifest | tags
Context
2013-01-27
10:04
Streamlined db access a little, test4 completes in reasonable time Closed-Leaf check-in: a893c641ca user: matt tags: http-transport
2013-01-25
23:55
Got http-server running clean against test1 check-in: d294210580 user: matt tags: http-transport
2013-01-17
12:05
http sucks version. well, my implementation using spiffy and http-client sucks. check-in: f7d6060988 user: mrwellan tags: http-transport
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified db.scm from [034ef23efd] to [2a22e51a7a].

︙
1315
1316
1317
1318
1319
1320
1321
1322
1323


1324
1325
1326
1327
1328
1329
1330

1315
1316
1317
1318
1319
1320
1321


1322
1323
1324
1325
1326
1327
1328
1329
1330








-
-
+
+








	 (server:reply return-address qry-sig #t 1)) ;; (length data)))
	((set-verbosity)
	 (set! *verbosity* (car params))
	 (server:reply return-address qry-sig #t '(#t *verbosity*)))
	((killserver)
	 (debug:print 0 "WARNING: Server going down in 15 seconds by user request!")
	 (open-run-close tasks:server-deregister tasks:open-db 
			 (cadr *server-info*)
			 pullport: (caddr *server-info*))
			 (car *runremote*)
			 pullport: (cadr *runremote*))
	 (thread-start! (make-thread (lambda ()(thread-sleep! 15)(exit))))
	 (server:reply return-address qry-sig #t '(#t "exit process started")))
	(else ;; not a command, i.e. is a query
	 (debug:print 0 "ERROR: Unrecognised query/command " stmt-key)
	 (server:reply pubsock return-address qry-sig #f 'failed))))
     (else
      (debug:print-info 11 "Executing " stmt-key " for " params)
︙

Modified server.scm from [0b00fa3bb5] to [7120661741].

︙
82
83
84
85
86
87
88
89

90
91

92
93
94
95
96
97
98

82
83
84
85
86
87
88

89
90

91
92
93
94
95
96
97
98








-
+

-
+








					  (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*)))
				     (mutex-lock! *db:process-queue-mutex*) ;; trying a mutex
				     ;; (mutex-lock! *db:process-queue-mutex*) ;; trying a mutex
				     (set! res (open-run-close db:process-queue-item open-db packet))
				     (mutex-unlock! *db:process-queue-mutex*)
				     ;; (mutex-unlock! *db:process-queue-mutex*)
				     (debug:print-info 11 "Return value from db:process-queue-item is " res)
				     (send-response body: (conc "<head>ctrl data</head>\n<body>"
								res
								"</body>")
						    headers: '((content-type text/plain)))))
				  (else (continue))))))))
    (server:try-start-server ipaddrstr start-port)))
︙

Modified tasks.scm from [38db4ca0e0] to [30537add33].

︙
174
175
176
177
178
179
180
181

182
183
184
185
186
187
188

174
175
176
177
178
179
180

181
182
183
184
185
186
187
188








-
+








;; ping each server in the db and return first found that responds. 
;; remove any others. will not necessarily remove all!
(define (tasks:get-best-server mdb)
  (let ((res '())
	(best #f))
    (sqlite3:for-each-row
     (lambda (id hostname interface port pid)
       (set! res (cons (list hostname interface port pid) res))
       (set! res (cons (list hostname interface port pid id) res))
       (debug:print-info 2 "Found existing server " hostname ":" port " registered in db"))
     mdb
     "SELECT id,hostname,interface,port,pid FROM servers
         WHERE strftime('%s','now')-heartbeat < 10
               AND mt_version=? ORDER BY start_time ASC LIMIT 1;" megatest-version)
    ;; for now we are keeping only one server registered in the db, return #f or first server found
    (if (null? res) #f (car res))))
︙

Modified tests/tests.scm from [052cb1980d] to [17571516a2].

︙
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
106
107
108
109
110
111
112
113
114
115
116
117
118

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
106
107
108




109
110
111
112
113
114
115








-
+
















-
+
+

-
+




-
-
-
-








;; S E R V E R
;;======================================================================

(test "setup for run" #t (begin (setup-for-run)
				(string? (getenv "MT_RUN_AREA_HOME"))))

(test "server-register, get-best-server" #t (let ((res #f))
					      (open-run-close tasks:server-register tasks:open-db 1 "bob" 1234 1235 100 'live)
					      (open-run-close tasks:server-register tasks:open-db 1 "bob" 1234 100 'live)
					      (set! res (open-run-close tasks:get-best-server tasks:open-db))
					      (number? (cadddr res))))

(test "de-register server" #t (let ((res #f))
				(open-run-close tasks:server-deregister tasks:open-db "bob" pullport: 1234)
				(list? (open-run-close tasks:get-best-server tasks:open-db))))

(define hostinfo #f)
(test "get-best-server" #t (let ((dat (open-run-close tasks:get-best-server tasks:open-db)))
			     (set! hostinfo dat) ;; host ip pullport pubport
			     (and (string? (car dat))
				  (number? (caddr dat)))))

(test #f #t (let ((zmq-socket (server:client-connect
			       (cadr hostinfo)
			       (caddr hostinfo)
			       (cadddr hostinfo))))
			       ;; (cadddr hostinfo)
			       )))
	      (set! *runremote* zmq-socket)
	      (socket? (vector-ref *runremote* 0))))
	      (string? (car *runremote*))))

(test #f #t (let ((res (server:client-login *runremote*)))
	      (car res)))

(test #f #t (socket? (vector-ref *runremote* 0)))

;; (test #f #t (server:client-setup))

(test #f #t (car (cdb:login *runremote* *toppath* *my-client-signature*)))

;;======================================================================
;; C O N F I G   F I L E S 
;;======================================================================

(define conffile #f)
︙

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