Changes In Branch http-transport Through [dae2c48a5c] Excluding Merge-Ins
This is equivalent to a diff from 977a37ad23 to dae2c48a5c
2013-01-22
| ||
10:30 | Cherrypicked changes to testzmq for running on Linux with no random command check-in: 64ef739ad9 user: mrwellan tags: trunk | |
2013-01-17
| ||
21:09 | build zmq 3.2.2 check-in: 432cf27357 user: mrwellan tags: zmq-3.2.2 | |
2013-01-14
| ||
22:17 | first pass implemenation using http check-in: 0d7a6d510a user: matt tags: http-transport | |
20:21 | example client and server for http check-in: dae2c48a5c user: matt tags: http-transport | |
13:41 | Start of trial use of http instead of zmq check-in: ab15a4abf5 user: mrwellan tags: http-transport | |
2013-01-09
| ||
15:50 | Missing runconfigs section. check-in: 977a37ad23 user: mrwellan tags: trunk | |
2013-01-07
| ||
20:15 | Added missing mockupclientlib file check-in: 7b5c5970ba user: matt tags: trunk | |
Modified Makefile from [a4b44c1e54] to [be8dc8c4a5].
︙ | ︙ | |||
15 16 17 18 19 20 21 | ADTLSCR=mt_laststep mt_runstep mt_ezstep HELPERS=$(addprefix $(PREFIX)/bin/,$(ADTLSCR)) DEPLOYHELPERS=$(addprefix $(DEPLOYTARG)/,$(ADTLSCR)) MTESTHASH=$(shell fossil info|grep checkout:| awk '{print $$2}') all : mtest dboard mtest: $(OFILES) megatest.o | | | 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 | ADTLSCR=mt_laststep mt_runstep mt_ezstep HELPERS=$(addprefix $(PREFIX)/bin/,$(ADTLSCR)) DEPLOYHELPERS=$(addprefix $(DEPLOYTARG)/,$(ADTLSCR)) MTESTHASH=$(shell fossil info|grep checkout:| awk '{print $$2}') all : mtest dboard mtest: $(OFILES) megatest.o csc -heap-size 1m $(CSCOPTS) $(OFILES) megatest.o -o mtest dboard : $(OFILES) $(GOFILES) csc $(OFILES) $(GOFILES) -o dboard $(DEPLOYTARG)/megatest : $(OFILES) megatest.o csc -deployed $(CSCOPTS) $(OFILES) megatest.o -o $(DEPLOYTARG)/megatest |
︙ | ︙ |
Added testhttp/example-client.scm version [83732ef8d7].
> > > | 1 2 3 | (use http-client) (print (with-input-from-request "http://localhost:8082/?foo=1" #f read-string)) |
Added testhttp/example-server.scm version [d5822303ef].
> > > > > > > > > > > > > > > > > > > > > > > > > > | 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 | (use spiffy awful) (tcp-buffer-size 2048) (enable-sxml #t) (define (hello-world) (define-page (main-page-path) (lambda () (with-request-variables (foo) (conc foo " Hello, world! Goodbye Dolly"))))) (define (start-server #!key (portnum 8080)) (handle-exceptions exn (begin (print-error-message exn) (if (< portnum 9000) (begin (print "WARNING: failed to start on portnum: " portnum ", trying next port") (sleep 1) (start-server portnum: (+ portnum 1))) (print "ERROR: Tried and tried but could not start the server"))) (print "INFO: Trying to start server on portnum: " portnum) (awful-start hello-world port: portnum))) (start-server) |
Added testhttp/mockupclient.scm version [fceab37de6].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 posix) (define cname "Bob") (define runtime 10) (let ((args (argv))) (if (< (length args) 3) (begin (print "Usage: mockupclient clientname runtime") (exit)) (begin (set! cname (cadr args)) (set! runtime (string->number (caddr args)))))) ;; (define start-delay (/ (random 100) 9)) ;; (define runtime (+ 1 (/ (random 200) 2))) (print "Starting client " cname " with runtime " runtime) (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.011))) (if (< (current-seconds) endtime) (loop)))) (print "Client " cname " all done!!") |
Added testhttp/mockupclientlib.scm version [6a9bd9de5d].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 | (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 cname cmd var val #!key (numtries 1)) (let* ((msg (conc cname ":" cmd ":" (if val (conc var " " val) var))) (res #f) (do-access (lambda () (print "Sending msg: " msg) (send-message push msg) (print "Message " msg " sent") (print "Client " cname " waiting for response to " msg) (print "Client " cname " received address " (receive-message* sub)) (set! res (receive-message* sub))))) (let ((th1 (make-thread do-access "do access")) (th2 (make-thread (lambda () (thread-sleep! 5) (if (not res) (if (> numtries 0) (begin (print "WARNING: access timed out for " cname ", trying again. Trys remaining=" numtries) (dbaccess cname cmd var val numtries: (- numtries 1))) (begin (print "ERROR: dbaccess timed out. Exiting") (exit))))) "timeout thread"))) (thread-start! th1) (thread-start! th2) (thread-join! th1) res))) |
Added testhttp/mockupserver.scm version [aa3c5bcdcf].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 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 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 | ;; 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 srfi-18 sqlite3 spiffy) (define cname "server") (define total-db-accesses 0) (define start-time (current-seconds)) ;; setup the server here (tcp-buffer-size 2048) (server-port 5563) (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) (let ((cid (hash-table-ref/default cid-cache cname #f))) (if cid cid (begin (execute db "INSERT OR REPLACE INTO clients (name) VALUES(?);" cname) (for-each-row (lambda (id) (set! cid id)) db "SELECT id FROM clients WHERE name=?;" cname) (hash-table-set! cid-cache cname cid) (set! total-db-accesses (+ total-db-accesses 2)) cid)))) (define (count-client db cname) (let ((cid (get-client-id db cname))) (execute db "UPDATE clients SET num_accesses=num_accesses+1 WHERE id=?;" cid) (set! total-db-accesses (+ total-db-accesses 1)) )) (define db (open-db)) ;; (define queuelst '()) ;; (define mx1 (make-mutex)) (define max-queue-len 0) (define (process-queue queuelst) (let ((queuelen (length queuelst))) (if (> queuelen max-queue-len) (set! max-queue-len queuelen)) (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) (conc queuelen)) ((set) (set! total-db-accesses (+ total-db-accesses 1)) (apply execute db "INSERT OR REPLACE INTO vars (var,val) VALUES (?,?);" (string-split cdata)) "ok") ((get) (set! total-db-accesses (+ total-db-accesses 1)) (let ((res "noval")) (for-each-row (lambda (val) (set! res val)) db "SELECT val FROM vars WHERE var=?;" cdata) res)) (else (conc "unk cmd: " clcmd)))))) queuelst))) (define th1 (make-thread (lambda () (let ((last-run 0)) ;; current-seconds when run last (let loop ((queuelst '())) (let* ((indat (receive-message* pull)) (parts (string-split indat ":")) (cname (car parts)) ;; client name (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 ((last-action-time (current-seconds))) ;; (let loop () ;; (thread-sleep! 5) ;; (let ((queuelen (string->number (dbaccess "server" 'sync "nada" #f))) ;; (last-action-delta #f)) ;; (if (> queuelen 1)(set! last-action-time (current-seconds))) ;; (set! last-action-delta (- (current-seconds) last-action-time)) ;; (print "Server: Got queuelen=" queuelen ", last-action-delta=" last-action-delta) ;; (if (< last-action-delta 60) ;; (loop) ;; (print "Server exiting, 25 seconds since last access")))))) ;; "sync thread")) (handle-not-found (thread-start! th1) (thread-start! th2) (thread-join! th2) (let* ((run-time (- (current-seconds) start-time)) (queries/second (/ total-db-accesses run-time))) (print "Server exited! Total db accesses=" total-db-accesses " in " run-time " seconds for " queries/second " queries/second with max queue length of: " max-queue-len)) |
Modified utils/installall.sh from [6bb115f66a] to [efda651786].
︙ | ︙ | |||
77 78 79 80 81 82 83 | cd chicken-${CHICKEN_VERSION} make PLATFORM=linux PREFIX=$PREFIX make PLATFORM=linux PREFIX=$PREFIX install cd $BUILDHOME fi # Some eggs are quoted since they are reserved to Bash | | | 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 | cd chicken-${CHICKEN_VERSION} make PLATFORM=linux PREFIX=$PREFIX make PLATFORM=linux PREFIX=$PREFIX install cd $BUILDHOME fi # Some eggs are quoted since they are reserved to Bash for f in matchable readline apropos base64 regex-literals format "regex-case" "test" coops trace csv dot-locking posix-utils posix-extras directory-utils hostinfo tcp rpc csv-xml fmt json md5 spiffy http-client; do if ! [[ -e $PREFIX/lib/chicken/6/$f.so ]];then chicken-install $PROX $f # chicken-install -deploy -prefix $DEPLOYTARG $PROX $f else echo Skipping install of egg $f as it is already installed fi done |
︙ | ︙ |