Megatest

Check-in [a742cdc5a5]
Login
Overview
Comment:Made mockup more realistic, works.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | interleaved-queries
Files: files | file ages | folders
SHA1: a742cdc5a5195f7e0c833b63d7df8d1b6d49d626
User & Date: matt on 2012-11-17 15:17:51
Other Links: branch diff | manifest | tags
Context
2012-11-17
16:20
Increased the number of clients to 520, added random wait and run times for clients check-in: 5258070648 user: matt tags: interleaved-queries
15:17
Made mockup more realistic, works. check-in: a742cdc5a5 user: matt tags: interleaved-queries
09:16
mockup works check-in: e576c93a7e user: matt tags: interleaved-queries
Changes

Modified testzmq/mockupclient.scm from [338ff2df35] to [b38730b037].

1
2
3
4
5
6
7
8
9
10

11
12
13
14
15
16
17
18


19
20

21
22

23
24
25
26
27
28
29
30
31
32

33
34
35
(use zmq posix)

(define cname "Bob")
(let ((args (argv)))
  (if (< (length args) 2)
      (begin
	(print "Usage: mockupclient clientname")
	(exit))
      (set! cname (cadr args))))
      

(define sub  (make-socket 'sub))
(define push (make-socket 'push))
(socket-option-set! sub 'subscribe cname)
(connect-socket sub "tcp://localhost:5563")
(connect-socket push "tcp://localhost:5564")

(define (dbaccess cmd var val)
  (let ((msg (conc cname ":" cmd ":" (if val (conc var " " val) var))))


    (print "Sending msg: " msg)
    (send-message push msg)

    (receive-message* sub)
    (receive-message* sub)))


(let loop ()
  (let ((x (random 15))
	(varname (list-ref (list "hello" "goodbye" "saluton" "kiaorana")(random 4))))
    (case x
      ((1)(dbaccess 'sync "nodat"    #f))
      ((2 3 4 5)(dbaccess 'set varname (random 999)))
      ((6 7 8 9 10)(print cname ": Get \"" varname "\" " (dbaccess 'get varname #f)))
      (else
       (thread-sleep! 0.01)))

    (loop)))












>
|
|
<
<
<

<
<
>
>
|
|
>
|
<
>





|
|
|

|
>
|

|
1
2
3
4
5
6
7
8
9
10
11
12
13



14


15
16
17
18
19
20

21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
(use zmq posix)

(define cname "Bob")
(let ((args (argv)))
  (if (< (length args) 2)
      (begin
	(print "Usage: mockupclient clientname")
	(exit))
      (set! cname (cadr args))))
      
(randomize)
(define start-delay (/ (random 100) 9))
(define runtime     (+ 1 (/ (random 200) 2)))






(print "client " cname " with start delay " start-delay " and runtime " runtime)
(thread-sleep! start-delay)
(print "client " cname " started")

(include "mockupclientlib.scm")


(set! endtime (+ (current-seconds) runtime))

(let loop ()
  (let ((x (random 15))
	(varname (list-ref (list "hello" "goodbye" "saluton" "kiaorana")(random 4))))
    (case x
      ((1)(dbaccess cname 'sync "nodat"    #f))
      ((2 3 4 5)(dbaccess cname 'set varname (random 999)))
      ((6 7 8 9 10)(print cname ": Get \"" varname "\" " (dbaccess cname 'get varname #f)))
      (else
       (thread-sleep! 0.1)))
    (if (< (current-seconds) endtime)
	(loop))))

(print "Client " cname " all done!!")

Modified testzmq/mockupserver.scm from [be351e0e07] to [cab71edb67].

1
2
3
4
5
6
7
8
9

10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

25
26
27
28
29
30
31
;; pub/sub with envelope address
;; Note that if you don't insert a sleep, the server will crash with SIGPIPE as soon
;; as a client disconnects.  Also a remaining client may receive tons of
;; messages afterward.

(use zmq srfi-18 sqlite3)

(define pub (make-socket 'pub))
(define pull (make-socket 'pull))


(bind-socket pub "tcp://*:5563")
(bind-socket pull "tcp://*:5564")

(define (open-db)
  (let* ((dbpath    "mockup.db")
	 (dbexists  (file-exists? dbpath))
	 (db        (open-database dbpath)) ;; (never-give-up-open-db dbpath))
	 (handler   (make-busy-timeout 10)))
    (set-busy-handler! db handler)
    (if (not dbexists)
	(for-each
	 (lambda (stmt)
	   (execute db stmt))
	 (list

	  "CREATE TABLE clients (id INTEGER PRIMARY KEY,name TEXT,num_accesses INTEGER DEFAULT 0);"
	  "CREATE TABLE vars    (var TEXT,val TEXT,CONSTRAINT vars_constraint UNIQUE (var));")))
    db))

(define cid-cache (make-hash-table))

(define (get-client-id db cname)









>















>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
;; pub/sub with envelope address
;; Note that if you don't insert a sleep, the server will crash with SIGPIPE as soon
;; as a client disconnects.  Also a remaining client may receive tons of
;; messages afterward.

(use zmq srfi-18 sqlite3)

(define pub (make-socket 'pub))
(define pull (make-socket 'pull))
(define cname "server")

(bind-socket pub "tcp://*:5563")
(bind-socket pull "tcp://*:5564")

(define (open-db)
  (let* ((dbpath    "mockup.db")
	 (dbexists  (file-exists? dbpath))
	 (db        (open-database dbpath)) ;; (never-give-up-open-db dbpath))
	 (handler   (make-busy-timeout 10)))
    (set-busy-handler! db handler)
    (if (not dbexists)
	(for-each
	 (lambda (stmt)
	   (execute db stmt))
	 (list
	  "PRAGMA SYNCHRONOUS=0;"
	  "CREATE TABLE clients (id INTEGER PRIMARY KEY,name TEXT,num_accesses INTEGER DEFAULT 0);"
	  "CREATE TABLE vars    (var TEXT,val TEXT,CONSTRAINT vars_constraint UNIQUE (var));")))
    db))

(define cid-cache (make-hash-table))

(define (get-client-id db cname)
54
55
56
57
58
59
60


61
62
63
64
65
66
67
  (for-each
   (lambda (item)
     (let ((cname (vector-ref item 1))
	   (clcmd (vector-ref item 2))
	   (cdata (vector-ref item 3)))
       (send-message pub cname send-more: #t)
       (send-message pub (case clcmd


			   ((set)
			    (apply execute db "INSERT OR REPLACE INTO vars (var,val) VALUES (?,?);" (string-split cdata))
			    "ok")
			   ((get)
			    (let ((res "noval"))
			      (for-each-row
			       (lambda (val)







>
>







56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
  (for-each
   (lambda (item)
     (let ((cname (vector-ref item 1))
	   (clcmd (vector-ref item 2))
	   (cdata (vector-ref item 3)))
       (send-message pub cname send-more: #t)
       (send-message pub (case clcmd
			   ((sync)
			    "ok")
			   ((set)
			    (apply execute db "INSERT OR REPLACE INTO vars (var,val) VALUES (?,?);" (string-split cdata))
			    "ok")
			   ((get)
			    (let ((res "noval"))
			      (for-each-row
			       (lambda (val)
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
			  (clcmd (string->symbol (cadr parts))) ;; client cmd
			  (cdata (caddr parts))                 ;; client data
			  (svect (vector (current-seconds) cname clcmd cdata))) ;; record for the queue
		     (count-client db cname)
		     (case clcmd
		       ((sync) ;; just process the queue
			(print "Got sync from " cname)
			(process-queue queuelst)
			(loop '()))
		       ((imediate)
			(process-queue (cons svect queuelst))
			(loop '()))
		       (else
			(loop (cons svect queuelst))))))))
	     "server thread"))

(define push (make-socket 'push))
(connect-socket push "tcp://localhost:5564")

;; send a sync to the pull port
(define th2 (make-thread
	     (lambda ()
	       (let loop ()
		 (thread-sleep! 5)
		 ;; (print "Sending sync from server")
		 (send-message push "server:sync:nodat")
		 (loop)))
	     "sync thread"))

(thread-start! th1)
(thread-start! th2)
(thread-join! th1)







|

|






|
<







|






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
			  (clcmd (string->symbol (cadr parts))) ;; client cmd
			  (cdata (caddr parts))                 ;; client data
			  (svect (vector (current-seconds) cname clcmd cdata))) ;; record for the queue
		     (count-client db cname)
		     (case clcmd
		       ((sync) ;; just process the queue
			(print "Got sync from " cname)
			(process-queue (cons svect queuelst))
			(loop '()))
		       ((get)
			(process-queue (cons svect queuelst))
			(loop '()))
		       (else
			(loop (cons svect queuelst))))))))
	     "server thread"))

(include "mockupclientlib.scm")


;; send a sync to the pull port
(define th2 (make-thread
	     (lambda ()
	       (let loop ()
		 (thread-sleep! 5)
		 ;; (print "Sending sync from server")
		 (dbaccess "server" 'sync "nada" #f)
		 (loop)))
	     "sync thread"))

(thread-start! th1)
(thread-start! th2)
(thread-join! th1)

Modified testzmq/testmockup.sh from [f4e842d377] to [422a24aae3].

8
9
10
11
12
13
14

15

16

17
18
19
20
21

22
23
24

echo Starting server
./mockupserver &

sleep 1

echo Starting clients

for i in a b c d e f g h i j k l m n o p q s t u v w x y z;do

  for j in 0 1 2 3 4 5 6 7 8 9;do

    echo Starting client $i$j
    ./mockupclient $i$j &
  done
done


echo "Running for one minute then killing all mockupserver and mockupclient processes"
sleep 60
killall -v mockupserver mockupclient







>
|
>
|
>





>
|
|
|
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28

echo Starting server
./mockupserver &

sleep 1

echo Starting clients
IVALS=
for i in a b c d e f g h i j k l m n o p q s t u v w x y z;
  do
  for j in 0 1 2 3 4 5 6 7 8 9;
    do
    echo Starting client $i$j
    ./mockupclient $i$j &
  done
done

wait
# echo "Running for one minute then killing all mockupserver and mockupclient processes"
# sleep 60
# killall -v mockupserver mockupclient