Artifact ed99458b4cd07252f80d08f16c49131791209834:
- Executable file nanomsg/survey — part of check-in [b7b9cf1065] at 2016-08-17 08:03:45 on branch trunk — fixed survey test for nanomsg (user: ovenpasta@pizzahack.eu size: 2221)
0000: 23 21 20 2f 75 73 72 2f 62 69 6e 2f 65 6e 76 20 #! /usr/bin/env 0010: 73 63 68 65 6d 65 2d 73 63 72 69 70 74 0a 3b 20 scheme-script.; 0020: 2d 2a 2d 20 6d 6f 64 65 3a 20 73 63 68 65 6d 65 -*- mode: scheme 0030: 20 2d 2a 2d 0a 0a 3b 20 47 65 74 74 69 6e 67 20 -*-..; Getting 0040: 53 74 61 72 74 65 64 20 77 69 74 68 20 27 6e 61 Started with 'na 0050: 6e 6f 6d 73 67 27 0a 3b 20 53 75 72 76 65 79 0a nomsg'.; Survey. 0060: 3b 20 66 72 6f 6d 20 68 74 74 70 73 3a 2f 2f 67 ; from https://g 0070: 69 74 68 75 62 2e 63 6f 6d 2f 64 79 73 69 6e 67 ithub.com/dysing 0080: 65 72 2f 6e 61 6e 6f 6d 73 67 2d 65 78 61 6d 70 er/nanomsg-examp 0090: 6c 65 73 23 73 75 72 76 65 79 0a 23 21 63 68 65 les#survey.#!che 00a0: 7a 73 63 68 65 6d 65 0a 0a 28 69 6d 70 6f 72 74 zscheme..(import 00b0: 20 28 6e 61 6e 6f 6d 73 67 29 20 28 63 68 65 7a (nanomsg) (chez 00c0: 73 63 68 65 6d 65 29 29 0a 0a 28 6e 61 6e 6f 6d scheme))..(nanom 00d0: 73 67 2d 6c 69 62 72 61 72 79 2d 69 6e 69 74 29 sg-library-init) 00e0: 0a 0a 28 64 65 66 69 6e 65 20 73 65 72 76 65 72 ..(define server 00f0: 2d 6e 61 6d 65 20 22 73 65 72 76 65 72 22 29 0a -name "server"). 0100: 28 64 65 66 69 6e 65 20 63 6c 69 65 6e 74 2d 6e (define client-n 0110: 61 6d 65 20 22 63 6c 69 65 6e 74 22 29 0a 28 64 ame "client").(d 0120: 65 66 69 6e 65 20 64 61 74 65 2d 6e 61 6d 65 20 efine date-name 0130: 22 44 41 54 45 22 29 0a 0a 28 64 65 66 69 6e 65 "DATE")..(define 0140: 20 64 61 74 65 20 64 61 74 65 2d 61 6e 64 2d 74 date date-and-t 0150: 69 6d 65 29 0a 0a 28 64 65 66 69 6e 65 20 28 73 ime)..(define (s 0160: 6c 65 65 70 2d 73 20 73 65 63 29 0a 20 20 28 73 leep-s sec). (s 0170: 6c 65 65 70 20 28 6d 61 6b 65 2d 74 69 6d 65 20 leep (make-time 0180: 27 74 69 6d 65 2d 64 75 72 61 74 69 6f 6e 20 30 'time-duration 0 0190: 20 73 65 63 29 29 29 0a 0a 28 64 65 66 69 6e 65 sec)))..(define 01a0: 20 28 73 65 72 76 65 72 20 75 72 6c 29 0a 20 20 (server url). 01b0: 28 64 65 66 69 6e 65 20 73 6f 63 6b 20 23 66 29 (define sock #f) 01c0: 0a 20 20 28 64 65 66 69 6e 65 20 65 69 64 20 23 . (define eid # 01d0: 66 29 0a 20 20 28 64 79 6e 61 6d 69 63 2d 77 69 f). (dynamic-wi 01e0: 6e 64 20 0a 20 20 20 20 20 20 28 6c 61 6d 62 64 nd . (lambd 01f0: 61 20 28 29 0a 09 28 73 65 74 21 20 73 6f 63 6b a ()..(set! sock 0200: 20 28 6e 6e 2d 73 6f 63 6b 65 74 20 41 46 5f 53 (nn-socket AF_S 0210: 50 20 4e 4e 5f 53 55 52 56 45 59 4f 52 29 29 29 P NN_SURVEYOR))) 0220: 0a 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 . (lambda ( 0230: 29 0a 09 28 73 65 74 21 20 65 69 64 20 28 6e 6e )..(set! eid (nn 0240: 2d 62 69 6e 64 20 73 6f 63 6b 20 75 72 6c 29 29 -bind sock url)) 0250: 0a 09 28 73 6c 65 65 70 2d 73 20 31 29 0a 09 0a ..(sleep-s 1)... 0260: 09 28 70 72 69 6e 74 66 20 22 53 45 52 56 45 52 .(printf "SERVER 0270: 3a 20 53 45 4e 44 49 4e 47 20 44 41 54 45 20 53 : SENDING DATE S 0280: 55 52 56 45 59 20 52 45 51 55 45 53 54 7e 6e 22 URVEY REQUEST~n" 0290: 29 0a 09 28 6e 6e 2d 73 65 6e 64 20 73 6f 63 6b )..(nn-send sock 02a0: 20 28 73 74 72 69 6e 67 2d 3e 75 74 66 38 20 64 (string->utf8 d 02b0: 61 74 65 2d 6e 61 6d 65 29 20 30 29 0a 09 28 6c ate-name) 0)..(l 02c0: 65 74 20 6c 6f 6f 70 20 28 29 0a 09 20 20 28 6c et loop ().. (l 02d0: 65 74 2a 20 28 5b 62 75 66 20 28 62 6f 78 20 23 et* ([buf (box # 02e0: 74 29 5d 0a 09 09 20 5b 62 79 74 65 73 20 28 67 t)]... [bytes (g 02f0: 75 61 72 64 20 28 78 20 5b 28 3d 20 28 6e 6e 2d uard (x [(= (nn- 0300: 65 72 72 6e 6f 29 20 45 54 49 4d 45 44 4f 55 54 errno) ETIMEDOUT 0310: 29 20 23 66 5d 29 0a 09 09 09 20 20 20 20 20 20 ) #f]).... 0320: 20 28 6e 6e 2d 72 65 63 76 20 73 6f 63 6b 20 62 (nn-recv sock b 0330: 75 66 20 4e 4e 5f 4d 53 47 20 30 29 29 5d 29 0a uf NN_MSG 0))]). 0340: 09 20 20 20 20 28 75 6e 6c 65 73 73 20 62 79 74 . (unless byt 0350: 65 73 0a 09 09 20 20 20 20 28 70 72 69 6e 74 66 es... (printf 0360: 20 22 53 45 52 56 45 52 3a 20 52 45 43 45 49 56 "SERVER: RECEIV 0370: 45 44 20 7e 64 20 53 55 52 56 45 59 20 52 45 53 ED ~d SURVEY RES 0380: 50 4f 4e 53 45 7e 6e 22 20 0a 09 09 09 20 20 20 PONSE~n" .... 0390: 20 28 75 74 66 38 2d 3e 73 74 72 69 6e 67 20 28 (utf8->string ( 03a0: 75 6e 62 6f 78 20 62 75 66 29 29 29 0a 09 09 20 unbox buf)))... 03b0: 20 20 20 28 6c 6f 6f 70 29 29 29 29 29 0a 20 20 (loop))))). 03c0: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 (lambda ().. 03d0: 28 69 66 20 65 69 64 20 28 6e 6e 2d 73 68 75 74 (if eid (nn-shut 03e0: 64 6f 77 6e 20 73 6f 63 6b 20 65 69 64 29 29 29 down sock eid))) 03f0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 6c 69 ))..(define (cli 0400: 65 6e 74 20 75 72 6c 20 6e 61 6d 65 29 0a 20 20 ent url name). 0410: 28 64 65 66 69 6e 65 20 73 6f 63 6b 20 23 66 29 (define sock #f) 0420: 0a 20 20 28 64 65 66 69 6e 65 20 65 69 64 20 23 . (define eid # 0430: 66 29 0a 20 20 28 64 79 6e 61 6d 69 63 2d 77 69 f). (dynamic-wi 0440: 6e 64 20 0a 20 20 20 20 20 20 28 6c 61 6d 62 64 nd . (lambd 0450: 61 20 28 29 0a 09 28 73 65 74 21 20 73 6f 63 6b a ()..(set! sock 0460: 20 28 6e 6e 2d 73 6f 63 6b 65 74 20 41 46 5f 53 (nn-socket AF_S 0470: 50 20 4e 4e 5f 52 45 53 50 4f 4e 44 45 4e 54 29 P NN_RESPONDENT) 0480: 29 29 0a 20 20 20 20 20 20 28 6c 61 6d 62 64 61 )). (lambda 0490: 20 28 29 0a 09 28 73 65 74 21 20 65 69 64 20 28 ()..(set! eid ( 04a0: 6e 6e 2d 63 6f 6e 6e 65 63 74 20 73 6f 63 6b 20 nn-connect sock 04b0: 75 72 6c 29 29 0a 09 28 6c 65 74 20 6c 6f 6f 70 url))..(let loop 04c0: 20 28 29 0a 09 20 20 28 6c 65 74 2a 20 28 5b 62 ().. (let* ([b 04d0: 75 66 20 28 62 6f 78 20 23 74 29 5d 0a 09 09 20 uf (box #t)]... 04e0: 5b 62 79 74 65 73 20 28 67 75 61 72 64 20 28 78 [bytes (guard (x 04f0: 20 5b 65 6c 73 65 20 23 66 5d 29 0a 09 09 09 20 [else #f]).... 0500: 20 20 20 20 20 20 28 6e 6e 2d 72 65 63 76 20 73 (nn-recv s 0510: 6f 63 6b 20 62 75 66 20 4e 4e 5f 4d 53 47 20 30 ock buf NN_MSG 0 0520: 29 29 5d 29 0a 09 20 20 20 20 28 77 68 65 6e 20 ))]).. (when 0530: 62 79 74 65 73 0a 09 09 20 20 28 70 72 69 6e 74 bytes... (print 0540: 66 20 22 43 4c 49 45 4e 54 20 28 7e 64 29 3a 20 f "CLIENT (~d): 0550: 52 45 43 45 49 56 45 44 20 7e 64 20 53 55 52 56 RECEIVED ~d SURV 0560: 45 59 20 52 45 51 55 45 53 54 7e 6e 22 20 0a 09 EY REQUEST~n" .. 0570: 09 09 20 20 6e 61 6d 65 20 28 75 74 66 38 2d 3e .. name (utf8-> 0580: 73 74 72 69 6e 67 20 28 75 6e 62 6f 78 20 62 75 string (unbox bu 0590: 66 29 29 29 0a 09 09 20 20 28 70 72 69 6e 74 66 f)))... (printf 05a0: 20 22 43 4c 49 45 4e 54 20 28 7e 64 29 3a 20 53 "CLIENT (~d): S 05b0: 45 4e 44 49 4e 47 20 44 41 54 45 20 53 55 52 56 ENDING DATE SURV 05c0: 45 59 20 52 45 53 50 4f 4e 53 45 7e 6e 22 20 0a EY RESPONSE~n" . 05d0: 09 09 09 20 20 6e 61 6d 65 29 0a 09 09 20 20 28 ... name)... ( 05e0: 6e 6e 2d 73 65 6e 64 20 73 6f 63 6b 20 28 73 74 nn-send sock (st 05f0: 72 69 6e 67 2d 3e 75 74 66 38 20 28 64 61 74 65 ring->utf8 (date 0600: 29 29 20 30 29 0a 09 09 20 20 28 6c 6f 6f 70 29 )) 0)... (loop) 0610: 29 29 29 29 0a 20 20 20 20 20 20 28 6c 61 6d 62 )))). (lamb 0620: 64 61 20 28 29 0a 09 28 69 66 20 65 69 64 20 28 da ()..(if eid ( 0630: 6e 6e 2d 73 68 75 74 64 6f 77 6e 20 73 6f 63 6b nn-shutdown sock 0640: 20 65 69 64 29 29 29 29 29 0a 0a 28 64 65 66 69 eid)))))..(defi 0650: 6e 65 20 61 72 67 76 20 28 63 6f 6d 6d 61 6e 64 ne argv (command 0660: 2d 6c 69 6e 65 2d 61 72 67 75 6d 65 6e 74 73 29 -line-arguments) 0670: 29 0a 28 64 65 66 69 6e 65 20 61 72 67 63 20 28 ).(define argc ( 0680: 6c 65 6e 67 74 68 20 61 72 67 76 29 29 0a 0a 28 length argv))..( 0690: 63 6f 6e 64 0a 20 5b 28 61 6e 64 20 28 3e 20 61 cond. [(and (> a 06a0: 72 67 63 20 31 29 20 28 73 74 72 69 6e 67 3d 3f rgc 1) (string=? 06b0: 20 73 65 72 76 65 72 2d 6e 61 6d 65 20 28 63 61 server-name (ca 06c0: 72 20 61 72 67 76 29 29 29 0a 20 20 28 73 65 72 r argv))). (ser 06d0: 76 65 72 20 28 63 61 64 72 20 61 72 67 76 29 29 ver (cadr argv)) 06e0: 5d 0a 20 5b 28 61 6e 64 20 28 3e 20 61 72 67 63 ]. [(and (> argc 06f0: 20 32 29 20 28 73 74 72 69 6e 67 3d 3f 20 63 6c 2) (string=? cl 0700: 69 65 6e 74 2d 6e 61 6d 65 20 28 63 61 72 20 61 ient-name (car a 0710: 72 67 76 29 29 29 0a 20 20 28 63 6c 69 65 6e 74 rgv))). (client 0720: 20 28 63 61 64 72 20 61 72 67 76 29 20 28 63 61 (cadr argv) (ca 0730: 64 64 72 20 61 72 67 76 29 29 5d 0a 20 5b 65 6c ddr argv))]. [el 0740: 73 65 0a 20 20 28 70 72 69 6e 74 66 20 22 55 73 se. (printf "Us 0750: 61 67 65 3a 20 73 75 72 76 65 79 20 7e 64 7c 7e age: survey ~d|~ 0760: 64 20 3c 55 52 4c 3e 20 3c 41 52 47 3e 20 2e 2e d <URL> <ARG> .. 0770: 2e 27 7e 6e 22 20 73 65 72 76 65 72 2d 6e 61 6d .'~n" server-nam 0780: 65 20 63 6c 69 65 6e 74 2d 6e 61 6d 65 29 5d 29 e client-name)]) 0790: 0a 0a 0a 23 21 65 6f 66 0a 0a 2e 2f 73 75 72 76 ...#!eof.../surv 07a0: 65 79 20 73 65 72 76 65 72 20 69 70 63 3a 2f 2f ey server ipc:// 07b0: 2f 74 6d 70 2f 73 75 72 76 65 79 2e 69 70 63 20 /tmp/survey.ipc 07c0: 26 20 73 65 72 76 65 72 3d 24 21 0a 2e 2f 73 75 & server=$!../su 07d0: 72 76 65 79 20 63 6c 69 65 6e 74 20 69 70 63 3a rvey client ipc: 07e0: 2f 2f 2f 74 6d 70 2f 73 75 72 76 65 79 2e 69 70 ///tmp/survey.ip 07f0: 63 20 63 6c 69 65 6e 74 30 20 26 20 63 6c 69 65 c client0 & clie 0800: 6e 74 30 3d 24 21 0a 2e 2f 73 75 72 76 65 79 20 nt0=$!../survey 0810: 63 6c 69 65 6e 74 20 69 70 63 3a 2f 2f 2f 74 6d client ipc:///tm 0820: 70 2f 73 75 72 76 65 79 2e 69 70 63 20 63 6c 69 p/survey.ipc cli 0830: 65 6e 74 31 20 26 20 63 6c 69 65 6e 74 31 3d 24 ent1 & client1=$ 0840: 21 0a 2e 2f 73 75 72 76 65 79 20 63 6c 69 65 6e !../survey clien 0850: 74 20 69 70 63 3a 2f 2f 2f 74 6d 70 2f 73 75 72 t ipc:///tmp/sur 0860: 76 65 79 2e 69 70 63 20 63 6c 69 65 6e 74 32 20 vey.ipc client2 0870: 26 20 63 6c 69 65 6e 74 32 3d 24 21 0a 73 6c 65 & client2=$!.sle 0880: 65 70 20 33 0a 6b 69 6c 6c 20 24 73 65 72 76 65 ep 3.kill $serve 0890: 72 20 24 63 6c 69 65 6e 74 30 20 24 63 6c 69 65 r $client0 $clie 08a0: 6e 74 31 20 24 63 6c 69 65 6e 74 32 0a nt1 $client2.