Mercurial > urweb
comparison tests/channelThief.ur @ 1942:a671e5258a2c
Raise exception when recv()ing from someone else's channel; improve setting of client ID in RPCs
| author | Adam Chlipala <adam@chlipala.net> |
|---|---|
| date | Fri, 27 Dec 2013 12:10:03 -0500 |
| parents | |
| children |
comparison
equal
deleted
inserted
replaced
| 1941:9f3597979e98 | 1942:a671e5258a2c |
|---|---|
| 1 table t : { Ch : channel string } | |
| 2 | |
| 3 fun go () = | |
| 4 let | |
| 5 fun overwrite () = | |
| 6 dml (DELETE FROM t WHERE TRUE); | |
| 7 ch <- channel; | |
| 8 dml (INSERT INTO t (Ch) VALUES ({[ch]})); | |
| 9 return ch | |
| 10 | |
| 11 fun retrieve () = | |
| 12 oneRowE1 (SELECT (t.Ch) FROM t) | |
| 13 | |
| 14 fun transmit () = | |
| 15 ch <- retrieve (); | |
| 16 send ch "Test" | |
| 17 | |
| 18 fun listenOn ch = | |
| 19 s <- recv ch; | |
| 20 alert s | |
| 21 in | |
| 22 ch <- overwrite (); | |
| 23 return <xml><body onload={listenOn ch}> | |
| 24 <button value="overwrite" onclick={fn _ => ch <- rpc (overwrite ()); listenOn ch}/> | |
| 25 <button value="retrieve" onclick={fn _ => ch <- rpc (retrieve ()); listenOn ch}/> | |
| 26 <button value="transmit" onclick={fn _ => rpc (transmit ())}/> | |
| 27 </body></xml> | |
| 28 end | |
| 29 | |
| 30 fun main () = return <xml><body> | |
| 31 <form><submit action={go}/></form> | |
| 32 </body></xml> |