Compare commits
704 Commits
Author | SHA1 | Date |
---|---|---|
Sam Caldwell | 0226b74305 | |
Sam Caldwell | 1607f7df45 | |
Sam Caldwell | e9703a4189 | |
Sam Caldwell | a0e8b59299 | |
Sam Caldwell | 042d667311 | |
Sam Caldwell | 2f17f77d31 | |
Sam Caldwell | b273586616 | |
Sam Caldwell | 26f15564f1 | |
Sam Caldwell | 3801174525 | |
Sam Caldwell | 4ab405fd70 | |
Sam Caldwell | e514453a12 | |
Sam Caldwell | c78cf5bb3d | |
Sam Caldwell | 59042f9180 | |
Sam Caldwell | 28b8bf742f | |
Sam Caldwell | 4808004d64 | |
Sam Caldwell | 45425eb68d | |
Sam Caldwell | 2064bd8f00 | |
Sam Caldwell | 6a7879c06e | |
Sam Caldwell | 643cc4d3ab | |
Sam Caldwell | e4ca56a002 | |
Sam Caldwell | 8af4464443 | |
Sam Caldwell | 0d839cbb12 | |
Sam Caldwell | 7a50ed2f5e | |
Sam Caldwell | 899fe287b4 | |
Sam Caldwell | 3d9b1c383c | |
Sam Caldwell | 7f54c4ccd0 | |
Sam Caldwell | 43cc25ea1b | |
Sam Caldwell | 798e66dc8c | |
Sam Caldwell | 2fb7f4795e | |
Sam Caldwell | b8d580faf3 | |
Sam Caldwell | 28e89297f9 | |
Sam Caldwell | a5e6caaa52 | |
Sam Caldwell | 2057a9f5a9 | |
Sam Caldwell | 3bdace6535 | |
Sam Caldwell | e42460b5e6 | |
Sam Caldwell | 788c9b0e46 | |
Sam Caldwell | c9b25df034 | |
Sam Caldwell | b9f655766f | |
Sam Caldwell | d2e753d303 | |
Sam Caldwell | 29b1171aa8 | |
Sam Caldwell | fc038877f5 | |
Sam Caldwell | e4f72519f0 | |
Sam Caldwell | 2327648499 | |
Sam Caldwell | 6985022a4b | |
Sam Caldwell | ce965d9025 | |
Sam Caldwell | 384d0dbdc1 | |
Sam Caldwell | 06aa3690c7 | |
Sam Caldwell | 6058330961 | |
Sam Caldwell | fe798f72a1 | |
Sam Caldwell | f5f15a5728 | |
Sam Caldwell | 98b773e7ee | |
Sam Caldwell | b4497f1623 | |
Sam Caldwell | 9952ff9400 | |
Sam Caldwell | fd59e58dc3 | |
Sam Caldwell | 481b490fd2 | |
Sam Caldwell | 3ec1048aad | |
Sam Caldwell | 55477446c2 | |
Sam Caldwell | 50cac93e1e | |
Sam Caldwell | fc6e012d1c | |
Sam Caldwell | 3b75881366 | |
Sam Caldwell | 690f9e65a8 | |
Sam Caldwell | 4f6089c805 | |
Sam Caldwell | aa74ffa14d | |
Sam Caldwell | 09ce074125 | |
Sam Caldwell | 3f6a5573e4 | |
Sam Caldwell | 98c58d3e6f | |
Sam Caldwell | c3559f1611 | |
Sam Caldwell | 8b67d0ba03 | |
Sam Caldwell | 52e64d6792 | |
Sam Caldwell | 59183b5fe9 | |
Sam Caldwell | 0191461137 | |
Sam Caldwell | 6b46be34f9 | |
Sam Caldwell | ff1ac58a36 | |
Sam Caldwell | c54b088a4d | |
Sam Caldwell | d5894e400b | |
Sam Caldwell | b023753091 | |
Sam Caldwell | 04530893f4 | |
Sam Caldwell | bd267cfaa9 | |
Sam Caldwell | d79378b4a3 | |
Sam Caldwell | 7a8628880a | |
Sam Caldwell | 145bc84e33 | |
Sam Caldwell | 549590d304 | |
Sam Caldwell | cb3f0546c0 | |
Sam Caldwell | 4e43c489d8 | |
Sam Caldwell | d0f00779cd | |
Sam Caldwell | 5a5c651321 | |
Sam Caldwell | 1fba368987 | |
Sam Caldwell | 7475c1896f | |
Sam Caldwell | 5a90933e9f | |
Sam Caldwell | 8dda1ba6bf | |
Sam Caldwell | 45f140d642 | |
Sam Caldwell | 95699308dd | |
Sam Caldwell | 362e102524 | |
Sam Caldwell | 78fee55ffa | |
Sam Caldwell | 2fd3771609 | |
Sam Caldwell | 8be62ed72c | |
Sam Caldwell | c9c2d2747b | |
Sam Caldwell | c20d075d03 | |
Sam Caldwell | 6dd369b08f | |
Sam Caldwell | c9a5af0d10 | |
Sam Caldwell | 7d8b62ff02 | |
Sam Caldwell | db2a8e1cec | |
Sam Caldwell | 3e13e3e449 | |
Sam Caldwell | 8a6931710a | |
Sam Caldwell | 1805b936be | |
Sam Caldwell | 25860019c6 | |
Sam Caldwell | abecc4996c | |
Sam Caldwell | d523dc7937 | |
Sam Caldwell | e75af5ae1c | |
Sam Caldwell | 4cd90a6295 | |
Sam Caldwell | f040a6db7e | |
Sam Caldwell | e5b797b450 | |
Sam Caldwell | bdf4c30218 | |
Sam Caldwell | 04b58f9d9f | |
Sam Caldwell | b66ab0bfcd | |
Sam Caldwell | 733c874871 | |
Sam Caldwell | fe6435f056 | |
Sam Caldwell | 659715cd0e | |
Sam Caldwell | 8446a0d770 | |
Sam Caldwell | 8288312890 | |
Sam Caldwell | 967da40b80 | |
Sam Caldwell | 1e434f8006 | |
Michael Ballantyne | c988c4f462 | |
Sam Caldwell | db3fc2acd9 | |
Michael Ballantyne | 50d2d1a6fa | |
Sam Caldwell | 122ef0b5f9 | |
Sam Caldwell | e1ca7ba2c4 | |
Sam Caldwell | 27b83e5e0a | |
Sam Caldwell | a1660114df | |
Sam Caldwell | 074ec24da4 | |
Sam Caldwell | 48344856c3 | |
Sam Caldwell | 165dfeb6c8 | |
Sam Caldwell | 38b5e34efb | |
Sam Caldwell | e2bb438704 | |
Sam Caldwell | a6fc1f20e4 | |
Sam Caldwell | 04995b5fb3 | |
Sam Caldwell | 2ba5366986 | |
Sam Caldwell | fc4413ec7a | |
Sam Caldwell | 2cdb894728 | |
Sam Caldwell | 0ed975c58c | |
Sam Caldwell | b59db5b3fd | |
Sam Caldwell | 2a589fcc18 | |
Sam Caldwell | dcd53f5dd5 | |
Sam Caldwell | 0d11850295 | |
Sam Caldwell | 7cf8f9fc0a | |
Sam Caldwell | d30007b798 | |
Sam Caldwell | a5dd55b907 | |
Sam Caldwell | 7e5c8e8eb7 | |
Sam Caldwell | 13e2ec7594 | |
Sam Caldwell | 2e9a0f6394 | |
Sam Caldwell | 5434e82299 | |
Sam Caldwell | 0999c9b75b | |
Sam Caldwell | 30430c391b | |
Sam Caldwell | 060ca752f3 | |
Sam Caldwell | af8dbeaa4b | |
Sam Caldwell | 35d3332698 | |
Sam Caldwell | 9b48e77b6d | |
Sam Caldwell | cc8d0fa30b | |
Sam Caldwell | 98c5c96356 | |
Sam Caldwell | 026e129de7 | |
Sam Caldwell | a2780484be | |
Sam Caldwell | 5c8986bddd | |
Sam Caldwell | 6c79e5cd5c | |
Sam Caldwell | 7ceed8e952 | |
Sam Caldwell | dca8ea2bad | |
Sam Caldwell | b8b5a1747a | |
Sam Caldwell | c38a47f5e3 | |
Sam Caldwell | 480feb961c | |
Sam Caldwell | f8c385e31d | |
Sam Caldwell | dee43c7f19 | |
Sam Caldwell | 18932662de | |
Sam Caldwell | 013ce19e68 | |
Sam Caldwell | f4701a3f70 | |
Stephen Chang | 056d467402 | |
Sam Caldwell | f19d2f3296 | |
Sam Caldwell | f3e2fcdc64 | |
Sam Caldwell | 2a95420366 | |
Sam Caldwell | 7cf0757ca6 | |
Sam Caldwell | 5823cf32c3 | |
Sam Caldwell | 18fdcdeff7 | |
Sam Caldwell | 90961e57f8 | |
Sam Caldwell | 6f8c9563aa | |
Sam Caldwell | 14db8ce919 | |
Sam Caldwell | 79277c91d3 | |
Sam Caldwell | e3d9f93eca | |
Sam Caldwell | 5f472b5402 | |
Sam Caldwell | 35827c970c | |
Sam Caldwell | 8bbab5317e | |
Sam Caldwell | ab15f7306f | |
Sam Caldwell | 606dd17e08 | |
Sam Caldwell | 32ebb804fb | |
Sam Caldwell | 3459fc8f71 | |
Sam Caldwell | 0a5ea2b920 | |
Sam Caldwell | e3d746b817 | |
Sam Caldwell | ed7c212561 | |
Sam Caldwell | 4e6b883c17 | |
Sam Caldwell | c9c3b9ec82 | |
Sam Caldwell | 9c0c9b3e77 | |
Sam Caldwell | 6ee5aa668b | |
Sam Caldwell | ecbfe56163 | |
Sam Caldwell | 7af6782ea8 | |
Sam Caldwell | ce9d563d8c | |
Sam Caldwell | 9e88cde0eb | |
Sam Caldwell | e554c797fb | |
Sam Caldwell | 89e42ae987 | |
Sam Caldwell | 161abab986 | |
Sam Caldwell | ce0dba8f36 | |
Sam Caldwell | 5a5fb74124 | |
Sam Caldwell | 9f8469467a | |
Sam Caldwell | 123124acb2 | |
Sam Caldwell | 7ba1ecf055 | |
Sam Caldwell | 5a19594fa1 | |
Sam Caldwell | 2a72f63084 | |
Sam Caldwell | 63c36d7010 | |
Sam Caldwell | d4b17154eb | |
Sam Caldwell | 5da04741f2 | |
Sam Caldwell | 4d6878626c | |
Sam Caldwell | 712dbd12c9 | |
Sam Caldwell | 9cdaf768d8 | |
Sam Caldwell | de88dc3c83 | |
Sam Caldwell | 5c6b473b62 | |
Sam Caldwell | b3cb16192c | |
Sam Caldwell | 945256b567 | |
Sam Caldwell | cefe70c590 | |
Sam Caldwell | e0d1975e2d | |
Sam Caldwell | d8516060c4 | |
Sam Caldwell | a1ca2372a5 | |
Sam Caldwell | 426b0899ac | |
Sam Caldwell | 1cd46da9d0 | |
Sam Caldwell | 1450665dc0 | |
Sam Caldwell | 9893f4dea1 | |
Sam Caldwell | 7dd9700c99 | |
Sam Caldwell | a41cee09bf | |
Sam Caldwell | 0d4f8df3b4 | |
Sam Caldwell | 116dcefc1a | |
Sam Caldwell | 9b4f76b0ac | |
Sam Caldwell | 989c6af818 | |
Sam Caldwell | d9da970742 | |
Sam Caldwell | 5d922fe030 | |
Sam Caldwell | c1190958bd | |
Sam Caldwell | 57d641dcc3 | |
Sam Caldwell | 397bebe4a3 | |
Sam Caldwell | b0ff2e8620 | |
Sam Caldwell | 6230ed577e | |
Sam Caldwell | 7994bfb9c6 | |
Sam Caldwell | 227768efd8 | |
Sam Caldwell | f20adacfde | |
Sam Caldwell | 67e0eebdc2 | |
Sam Caldwell | 7445626d0b | |
Sam Caldwell | 6778417639 | |
Sam Caldwell | b7ec18e52d | |
Sam Caldwell | 89ce5dca28 | |
Sam Caldwell | b1d14d8559 | |
Sam Caldwell | 7026d6908d | |
Sam Caldwell | 292e16f8b8 | |
Sam Caldwell | 60c58d2b7b | |
Sam Caldwell | d91f13bd2c | |
Sam Caldwell | 5965115611 | |
Sam Caldwell | adc0819be0 | |
Sam Caldwell | 49b34268ad | |
Sam Caldwell | d5a8d27ae3 | |
Sam Caldwell | 4e335f8049 | |
Sam Caldwell | d236d99d47 | |
Sam Caldwell | a0a30c719a | |
Sam Caldwell | cf2162797a | |
Sam Caldwell | 7b9595a22a | |
Sam Caldwell | 667231d3e8 | |
Sam Caldwell | 6b58c20832 | |
Sam Caldwell | b9e99fc8af | |
Sam Caldwell | 45e7ea609d | |
Sam Caldwell | f6976c0281 | |
Sam Caldwell | 0752089101 | |
Sam Caldwell | ad4b94422d | |
Sam Caldwell | b56319042c | |
Sam Caldwell | f4f517cd02 | |
Sam Caldwell | c9378d057d | |
Sam Caldwell | 9cb884a490 | |
Sam Caldwell | e7f792e624 | |
Sam Caldwell | f1be0fdfac | |
Sam Caldwell | 93e1fea202 | |
Sam Caldwell | 16ce86c6c9 | |
Sam Caldwell | c097e218d0 | |
Sam Caldwell | 12fd4ad756 | |
Sam Caldwell | f460011a5d | |
Sam Caldwell | 51e26efda6 | |
Sam Caldwell | 122f7629c3 | |
Sam Caldwell | c96725b8e3 | |
Sam Caldwell | 1feab5d174 | |
Sam Caldwell | 530c17ff32 | |
Sam Caldwell | ed01517c8c | |
Sam Caldwell | 10ae47c26c | |
Sam Caldwell | 6f52c7fc61 | |
Sam Caldwell | 9d5453ff5b | |
Sam Caldwell | f00ec81e48 | |
Sam Caldwell | b1cca8f377 | |
Sam Caldwell | cf17ae28a5 | |
Sam Caldwell | f6cd87394e | |
Sam Caldwell | 39d81686fd | |
Sam Caldwell | 2ddafb240a | |
Sam Caldwell | e88b64f5c1 | |
Sam Caldwell | 82705763b4 | |
Sam Caldwell | 581319eacb | |
Sam Caldwell | 3c800a92db | |
Sam Caldwell | 29c446df39 | |
Sam Caldwell | 006e5e0bf5 | |
Sam Caldwell | f9dcad855e | |
Sam Caldwell | fa7af3444c | |
Sam Caldwell | 58c1b52ac4 | |
Sam Caldwell | d5ac65007e | |
Sam Caldwell | 572be6b45d | |
Sam Caldwell | 5752c9299c | |
Sam Caldwell | 7dfc4a93da | |
Sam Caldwell | ff81748848 | |
Sam Caldwell | f0c52f6eaa | |
Sam Caldwell | e141abd678 | |
Sam Caldwell | d285de5bb2 | |
Sam Caldwell | 04f4acbda3 | |
Sam Caldwell | abce2d6046 | |
Sam Caldwell | d35495029b | |
Tony Garnock-Jones | 38f6351d43 | |
Tony Garnock-Jones | cd98c3048d | |
Tony Garnock-Jones | d1fbe26bc1 | |
Sam Caldwell | a3380ea403 | |
Sam Caldwell | 3957f031c1 | |
Sam Caldwell | f85203ac73 | |
Sam Caldwell | 0da903e438 | |
Sam Caldwell | 22bd143025 | |
Sam Caldwell | a6d6ceaa7c | |
Sam Caldwell | abc8669b74 | |
Sam Caldwell | a98ba7baab | |
Sam Caldwell | 702c53f7d1 | |
Sam Caldwell | bb028b1af8 | |
Sam Caldwell | fb778ab1ee | |
Sam Caldwell | 5cb0462ec4 | |
Sam Caldwell | 0897036557 | |
Sam Caldwell | d363bd0c46 | |
Sam Caldwell | 0c37b4e0b7 | |
Sam Caldwell | c7cc84302e | |
Sam Caldwell | 3a06e2324c | |
Sam Caldwell | 36420274cb | |
Sam Caldwell | c7d78159e3 | |
Sam Caldwell | 7c3d87eeb2 | |
Sam Caldwell | 221a550aed | |
Sam Caldwell | d8df2beb3e | |
Sam Caldwell | 817e292760 | |
Sam Caldwell | 7117816a74 | |
Sam Caldwell | 1b0f41f465 | |
Sam Caldwell | c11d719f20 | |
Sam Caldwell | 70aafc8bdf | |
Sam Caldwell | dcc6bbcbe7 | |
Sam Caldwell | 1b7d5a2330 | |
Sam Caldwell | 1b5cf6d772 | |
Sam Caldwell | 57934b389f | |
Sam Caldwell | 46379858c2 | |
Sam Caldwell | 139e0bcac5 | |
Sam Caldwell | 86330bde03 | |
Sam Caldwell | 0f2469c364 | |
Sam Caldwell | 144e20bdde | |
Sam Caldwell | 5104677fc6 | |
Sam Caldwell | cabb4e2e7c | |
Sam Caldwell | d7fc251bc8 | |
Sam Caldwell | 94823854c0 | |
Sam Caldwell | a9665d93d0 | |
Sam Caldwell | ad2e337268 | |
Sam Caldwell | 00bf7d2364 | |
Sam Caldwell | 632c04139b | |
Sam Caldwell | 6d2d14459c | |
Sam Caldwell | 03285824c7 | |
Sam Caldwell | ddff1c800c | |
Sam Caldwell | c66b62cf46 | |
Sam Caldwell | e7e8f5e174 | |
Sam Caldwell | 938d3c519d | |
Sam Caldwell | 35b3811462 | |
Sam Caldwell | af91b669b7 | |
Sam Caldwell | 5130197e27 | |
Sam Caldwell | 3705d95856 | |
Sam Caldwell | 33af13016b | |
Sam Caldwell | 1a4fc4dd4f | |
Sam Caldwell | e79237b1d3 | |
Sam Caldwell | 4bd8d20b0b | |
Sam Caldwell | 5803b8f9b0 | |
Sam Caldwell | 5bd391dd77 | |
Sam Caldwell | 71c2846a93 | |
Sam Caldwell | 29e09ff3ef | |
Sam Caldwell | 1e66554b8e | |
Sam Caldwell | 8808b5aca9 | |
Sam Caldwell | 5124b8e715 | |
Sam Caldwell | ceb0c60d20 | |
Sam Caldwell | fb675a850c | |
Sam Caldwell | 46a833a66e | |
Sam Caldwell | 5934c1626f | |
Sam Caldwell | 9a3d921de3 | |
Sam Caldwell | cff784384a | |
Sam Caldwell | b1c000e12e | |
Sam Caldwell | 82e5c8504c | |
Tony Garnock-Jones | 47094c11c4 | |
Tony Garnock-Jones | eb70563edb | |
Tony Garnock-Jones | c564bd28ec | |
Tony Garnock-Jones | cb351eee09 | |
Sam Caldwell | 7d9f505fc6 | |
Sam Caldwell | e402725d7f | |
Sam Caldwell | f1c51661c7 | |
Tony Garnock-Jones | f64ad8389a | |
Tony Garnock-Jones | 06224b52a8 | |
Tony Garnock-Jones | 1fa5167e20 | |
Tony Garnock-Jones | 55e1f09484 | |
Tony Garnock-Jones | af150712e0 | |
Tony Garnock-Jones | 57a40e9576 | |
Tony Garnock-Jones | 62f8385b24 | |
Tony Garnock-Jones | 22d837d6a4 | |
Tony Garnock-Jones | 1ab4f0f525 | |
Tony Garnock-Jones | f11f4fd054 | |
Tony Garnock-Jones | eb44003317 | |
Tony Garnock-Jones | eb564fdb7c | |
Tony Garnock-Jones | c9ec9f6be9 | |
Tony Garnock-Jones | 75093d0e1a | |
Tony Garnock-Jones | 1dbab91ccc | |
Tony Garnock-Jones | 53e26b08a1 | |
Sam Tobin-Hochstadt | 87495bdc37 | |
Tony Garnock-Jones | 710e75dffa | |
Tony Garnock-Jones | d51a513f8b | |
Tony Garnock-Jones | bf0eb16643 | |
Tony Garnock-Jones | 8999b8446d | |
Tony Garnock-Jones | fa82634868 | |
Tony Garnock-Jones | 45eee62fc2 | |
Tony Garnock-Jones | 5904a2f956 | |
Tony Garnock-Jones | 32d1274a8d | |
Tony Garnock-Jones | 18b3ab0d97 | |
Tony Garnock-Jones | fc0e900485 | |
Tony Garnock-Jones | 0526364698 | |
Tony Garnock-Jones | 70a56e6457 | |
Tony Garnock-Jones | 22998de0dc | |
Tony Garnock-Jones | 801470ebaa | |
Tony Garnock-Jones | 66e2e8b1a7 | |
Tony Garnock-Jones | 14f1cbd4fa | |
Tony Garnock-Jones | 275b60310f | |
Tony Garnock-Jones | ca0de7d52f | |
Tony Garnock-Jones | 16bd0155cc | |
Tony Garnock-Jones | eb07be548e | |
Tony Garnock-Jones | 5254feb4de | |
Tony Garnock-Jones | db333a266f | |
Tony Garnock-Jones | d96477b9db | |
Tony Garnock-Jones | 0599f974b9 | |
Tony Garnock-Jones | 4f52ebf108 | |
Tony Garnock-Jones | fa257a1d16 | |
Tony Garnock-Jones | 7a4d528dc0 | |
Tony Garnock-Jones | 4a51141500 | |
Tony Garnock-Jones | 51ab2921c2 | |
Tony Garnock-Jones | e41290c509 | |
Tony Garnock-Jones | 6c4ae38499 | |
Tony Garnock-Jones | 4a4f43b2cb | |
Tony Garnock-Jones | 903ed5deaa | |
Tony Garnock-Jones | 2a5d8ebdd4 | |
Tony Garnock-Jones | 96331e0cfd | |
Tony Garnock-Jones | e124983e05 | |
Tony Garnock-Jones | a82b428f44 | |
Tony Garnock-Jones | 516f6a5cd2 | |
Tony Garnock-Jones | 6a436f4c12 | |
Tony Garnock-Jones | 5ce1cec2ea | |
Tony Garnock-Jones | d0e803ac41 | |
Tony Garnock-Jones | 0acd504d05 | |
Tony Garnock-Jones | e0dc583f51 | |
Tony Garnock-Jones | 2a0197b711 | |
Tony Garnock-Jones | 930e4270b4 | |
Tony Garnock-Jones | 88d324929d | |
Tony Garnock-Jones | 8cbabafbab | |
Tony Garnock-Jones | cb3eee64dc | |
Tony Garnock-Jones | b2e2674f44 | |
Tony Garnock-Jones | 3db51ffda5 | |
Tony Garnock-Jones | fdcd9b9388 | |
Tony Garnock-Jones | e2d1ae853c | |
Tony Garnock-Jones | af30c19ee0 | |
Tony Garnock-Jones | f3b5fd6cd1 | |
Tony Garnock-Jones | 6728fcf10d | |
Tony Garnock-Jones | 09d0fb620d | |
Tony Garnock-Jones | 84ec153a1e | |
Tony Garnock-Jones | 4efe18bfe0 | |
Tony Garnock-Jones | 9009fb5ec7 | |
Tony Garnock-Jones | 40961e7893 | |
Tony Garnock-Jones | b3a745dbcb | |
Tony Garnock-Jones | c9996d53ae | |
Tony Garnock-Jones | 837ab77002 | |
Tony Garnock-Jones | 6b3f8d920a | |
Tony Garnock-Jones | 61b683fc94 | |
Tony Garnock-Jones | 4f8bc6e5af | |
Tony Garnock-Jones | 6703c5ef9a | |
Tony Garnock-Jones | a4ae0ae270 | |
Tony Garnock-Jones | 4f21e9ab46 | |
Tony Garnock-Jones | 5bff630547 | |
Tony Garnock-Jones | f83f286e28 | |
Tony Garnock-Jones | 11de40ce98 | |
Tony Garnock-Jones | f9a477832a | |
Tony Garnock-Jones | 1e42059c0f | |
Tony Garnock-Jones | 81bd857259 | |
Tony Garnock-Jones | 0719d78ca8 | |
Tony Garnock-Jones | 38032448bd | |
Tony Garnock-Jones | 203de5807f | |
Tony Garnock-Jones | 24ac40b251 | |
Tony Garnock-Jones | 75aee96e1a | |
Tony Garnock-Jones | aaa395df3a | |
Tony Garnock-Jones | eeb655a0ac | |
Tony Garnock-Jones | 6b2ee53fa8 | |
Tony Garnock-Jones | e864ca4c2c | |
Tony Garnock-Jones | 194c8013b1 | |
Sam Caldwell | 5f621b098e | |
Tony Garnock-Jones | 852e93328f | |
Tony Garnock-Jones | 8de523d8ee | |
Tony Garnock-Jones | 0e28e4c572 | |
Tony Garnock-Jones | 81a0351828 | |
Tony Garnock-Jones | 6e399dd1dd | |
Tony Garnock-Jones | 28f6b8acf8 | |
Tony Garnock-Jones | b189a249f8 | |
Tony Garnock-Jones | 7ddcebfddb | |
Tony Garnock-Jones | a090ed8330 | |
Tony Garnock-Jones | 8a2ace112b | |
Tony Garnock-Jones | f6c145b4a7 | |
Tony Garnock-Jones | 46e5922dc8 | |
Tony Garnock-Jones | 6db1e67a7e | |
Tony Garnock-Jones | 76c1a5b347 | |
Tony Garnock-Jones | 990ad4ca72 | |
Tony Garnock-Jones | 3073d8b614 | |
Tony Garnock-Jones | 37cee0c937 | |
Tony Garnock-Jones | ac5c5d2e5f | |
Tony Garnock-Jones | 1fdd62d56d | |
Tony Garnock-Jones | 46fd5e2b92 | |
Tony Garnock-Jones | 9b54069ecd | |
Tony Garnock-Jones | 42742fe8ac | |
Tony Garnock-Jones | 966cd2ed17 | |
Tony Garnock-Jones | 4be0a8cb59 | |
Tony Garnock-Jones | b9dfd79f34 | |
Sam Caldwell | 6448188e82 | |
Sam Caldwell | 9498f5129e | |
Tony Garnock-Jones | 425a5abac3 | |
Sam Caldwell | c15b75ecae | |
Sam Caldwell | d4f95d3a7b | |
Sam Caldwell | 460d72d69e | |
Sam Caldwell | a8421f3929 | |
Sam Caldwell | 36ff30c289 | |
Sam Caldwell | da422ff117 | |
Sam Caldwell | 88f515a98f | |
Sam Caldwell | fb3918404c | |
Sam Caldwell | 6ee97839fa | |
Sam Caldwell | e57af91698 | |
Sam Caldwell | 318363f4be | |
Sam Caldwell | c8cc8051a1 | |
Sam Caldwell | 34c3b6bf3a | |
Sam Caldwell | 90bf07f6d4 | |
Sam Caldwell | 079e2da53d | |
Sam Caldwell | df40cc7ba9 | |
Sam Caldwell | 3986f4d0ea | |
Sam Caldwell | e1671ce878 | |
Sam Caldwell | da1f9d4b6d | |
Sam Caldwell | 5544052488 | |
Sam Caldwell | 7b1c102224 | |
Sam Caldwell | 1be415eb45 | |
Sam Caldwell | 53cd60f196 | |
Sam Caldwell | f19a02e859 | |
Sam Caldwell | 5a87428f62 | |
Tony Garnock-Jones | 118cdef4c6 | |
Tony Garnock-Jones | 689d410bda | |
Tony Garnock-Jones | 66667d9fe6 | |
Tony Garnock-Jones | cddce5a02b | |
Sam Caldwell | e0e7baed46 | |
Tony Garnock-Jones | dc83d33afb | |
Tony Garnock-Jones | c51f18efc2 | |
Sam Caldwell | 921b84e056 | |
Tony Garnock-Jones | ea1b1bc072 | |
Tony Garnock-Jones | 6f70eaf93e | |
Tony Garnock-Jones | ee52520a13 | |
Sam Caldwell | 783d132f25 | |
Sam Caldwell | 99ccc12fee | |
Sam Caldwell | 27cb9ba983 | |
Sam Caldwell | 1f4bf075b7 | |
Tony Garnock-Jones | 1bfc4bbdad | |
Tony Garnock-Jones | d2bd2cd63e | |
Tony Garnock-Jones | aff57a1247 | |
Tony Garnock-Jones | e61dbf19f6 | |
Tony Garnock-Jones | 6d8ced489c | |
Tony Garnock-Jones | deefa251d9 | |
Tony Garnock-Jones | 1f8bb56c69 | |
Sam Caldwell | 1134ed0eff | |
Sam Caldwell | 9c1e9719ba | |
Tony Garnock-Jones | 413840382b | |
Sam Caldwell | 2b19064960 | |
Tony Garnock-Jones | 25729454a6 | |
Tony Garnock-Jones | 36459c5942 | |
Tony Garnock-Jones | 6adcf81c0d | |
Tony Garnock-Jones | e593cf768b | |
Tony Garnock-Jones | 19bebc9881 | |
Tony Garnock-Jones | eb4a228c73 | |
Tony Garnock-Jones | 7cc62688f9 | |
Tony Garnock-Jones | 9b50df1570 | |
Tony Garnock-Jones | 2f5f4c8d8d | |
Tony Garnock-Jones | 4d2252b90a | |
Tony Garnock-Jones | 038ea39b30 | |
Tony Garnock-Jones | 4454fe4c03 | |
Tony Garnock-Jones | b946bbec3c | |
Tony Garnock-Jones | 4940c0b372 | |
Tony Garnock-Jones | 6a2163bce9 | |
Tony Garnock-Jones | 75bc4a8ca5 | |
Tony Garnock-Jones | 7067c06961 | |
Tony Garnock-Jones | c7db9f2543 | |
Tony Garnock-Jones | f13fc9cad3 | |
Tony Garnock-Jones | bf20d84935 | |
Tony Garnock-Jones | 132032b602 | |
Tony Garnock-Jones | b87639b7a4 | |
Tony Garnock-Jones | d9905df4e5 | |
Tony Garnock-Jones | f440911e7f | |
Tony Garnock-Jones | 985403894f | |
Tony Garnock-Jones | 88ff347744 | |
Tony Garnock-Jones | db0282ca72 | |
Tony Garnock-Jones | cbdc19fc8e | |
Tony Garnock-Jones | c019a61c18 | |
Tony Garnock-Jones | 64cfce2472 | |
Tony Garnock-Jones | 51a28b9349 | |
Tony Garnock-Jones | 26d4a75318 | |
Tony Garnock-Jones | 803e3f6fd5 | |
Tony Garnock-Jones | 4ee234f118 | |
Tony Garnock-Jones | 73e0ba315a | |
Tony Garnock-Jones | 6af0ec70c8 | |
Tony Garnock-Jones | 0facbc90b3 | |
Tony Garnock-Jones | c2ece35bf9 | |
Tony Garnock-Jones | 78cb6f0c02 | |
Tony Garnock-Jones | 97b194487b | |
Tony Garnock-Jones | ae6c5a409f | |
Tony Garnock-Jones | 97bb848611 | |
Tony Garnock-Jones | d0d7e677fe | |
Tony Garnock-Jones | d9cc478e6c | |
Tony Garnock-Jones | 8cd60417c4 | |
Tony Garnock-Jones | 726b936ed3 | |
Tony Garnock-Jones | 02c0af4c75 | |
Tony Garnock-Jones | 885a1d05d6 | |
Tony Garnock-Jones | 9bb831cac5 | |
Tony Garnock-Jones | f677c3a888 | |
Tony Garnock-Jones | 3a3d216908 | |
Tony Garnock-Jones | bde2d833bd | |
Tony Garnock-Jones | f638923c6f | |
Tony Garnock-Jones | 05c57ec05d | |
Tony Garnock-Jones | c77513e838 | |
Tony Garnock-Jones | e7402e4387 | |
Tony Garnock-Jones | 260a99e08b | |
Tony Garnock-Jones | bab5aba083 | |
Tony Garnock-Jones | 8202220fec | |
Tony Garnock-Jones | 2f7313a489 | |
Tony Garnock-Jones | ad2874f463 | |
Tony Garnock-Jones | 8f181f5b4d | |
Tony Garnock-Jones | b72fca51b0 | |
Tony Garnock-Jones | f1a7e10fbf | |
Tony Garnock-Jones | 7b5b866a6d | |
Tony Garnock-Jones | 16d9dd27c9 | |
Tony Garnock-Jones | 990ae8ea9a | |
Tony Garnock-Jones | 0a585d7842 | |
Tony Garnock-Jones | 4af472f7ff | |
Tony Garnock-Jones | a3335800f6 | |
Tony Garnock-Jones | f201bea5c6 | |
Tony Garnock-Jones | f0f29007df | |
Tony Garnock-Jones | 257c0bf628 | |
Tony Garnock-Jones | 0d34e3280e | |
Tony Garnock-Jones | 3ce8bc380b | |
Tony Garnock-Jones | 4b99b629df | |
Tony Garnock-Jones | 97a843ccec | |
Tony Garnock-Jones | c302e35024 | |
Tony Garnock-Jones | 0102a7d1cd | |
Tony Garnock-Jones | 6497cc5185 | |
Tony Garnock-Jones | 4d6a2986d5 | |
Tony Garnock-Jones | c8b7be22cc | |
Tony Garnock-Jones | 9d34ffea4f | |
Tony Garnock-Jones | b2c795c57a | |
Tony Garnock-Jones | c595c638b2 | |
Tony Garnock-Jones | a7a2a5c492 | |
Tony Garnock-Jones | c6ca757a7e | |
Tony Garnock-Jones | 08f1e7506b | |
Tony Garnock-Jones | bc346ff38a | |
Tony Garnock-Jones | 594bb3989b | |
Tony Garnock-Jones | c77793f7fd | |
Tony Garnock-Jones | 15504cccab | |
Tony Garnock-Jones | 490e414904 | |
Tony Garnock-Jones | d442f4890f | |
Tony Garnock-Jones | 4a39a03a0a | |
Tony Garnock-Jones | c9eddfa0b7 | |
Tony Garnock-Jones | 2d1ad8a62d | |
Tony Garnock-Jones | 37af1e8726 | |
Tony Garnock-Jones | ea997539a2 | |
Tony Garnock-Jones | e90c0e580e | |
Tony Garnock-Jones | acd9dde2b8 | |
Tony Garnock-Jones | cd83b5f5d8 | |
Tony Garnock-Jones | 171a51d68c | |
Tony Garnock-Jones | e0ce5eb5b4 | |
Tony Garnock-Jones | 0f3db4eac6 | |
Tony Garnock-Jones | d1c858a7ae | |
Tony Garnock-Jones | 773d1e953b | |
Tony Garnock-Jones | d00f0cbf13 | |
Tony Garnock-Jones | 4ea2586666 | |
Tony Garnock-Jones | be7cf7417d | |
Tony Garnock-Jones | 39e46c1cfa | |
Tony Garnock-Jones | 8f28ae0e9c | |
Tony Garnock-Jones | 694de50bc0 | |
Tony Garnock-Jones | c1681f7804 | |
Tony Garnock-Jones | e7dc36f126 | |
Tony Garnock-Jones | 9a62eb6076 | |
Tony Garnock-Jones | aab25684b8 | |
Tony Garnock-Jones | 7be8eb6d60 | |
Tony Garnock-Jones | 9080396bc5 | |
Tony Garnock-Jones | bb889542fc |
17
README.md
17
README.md
|
@ -47,6 +47,19 @@ This repository contains
|
||||||
- a sketch of a Haskell implementation of the core routing structures
|
- a sketch of a Haskell implementation of the core routing structures
|
||||||
of Syndicate in `hs/`
|
of Syndicate in `hs/`
|
||||||
|
|
||||||
## Copyright
|
## Copyright and License
|
||||||
|
|
||||||
Copyright © Tony Garnock-Jones 2010, 2011, 2012, 2013, 2014, 2015, 2016.
|
Copyright © Tony Garnock-Jones 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018.
|
||||||
|
|
||||||
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU Lesser General Public License as published by
|
||||||
|
the Free Software Foundation, either version 3 of the License, or
|
||||||
|
(at your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful,
|
||||||
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
GNU Lesser General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU Lesser General Public License
|
||||||
|
along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
|
@ -0,0 +1,2 @@
|
||||||
|
scratch/
|
||||||
|
compiled/
|
|
@ -0,0 +1,7 @@
|
||||||
|
all:
|
||||||
|
|
||||||
|
run:
|
||||||
|
raco make main.rkt && racket main.rkt
|
||||||
|
|
||||||
|
clean:
|
||||||
|
rm -rf compiled
|
|
@ -0,0 +1,17 @@
|
||||||
|
Try changing the motd and saving the file. It'll reload. The log
|
||||||
|
messages suggest that the server is dropping extant connection - as
|
||||||
|
expected - but it immediately comes back momentarily before going away
|
||||||
|
properly. The session is able to reboot due to the glitching in
|
||||||
|
assertion of the listen port *more quickly* than the latency of
|
||||||
|
teardown of the previous connection; so the new session-listener
|
||||||
|
responds to the assertions from the old connection before the old
|
||||||
|
connection has a chance to die. Of course, it *does* die (since commit
|
||||||
|
11de40c), but having that zombie reborn new session is annoying.
|
||||||
|
|
||||||
|
- This is thorny. You'd think that having a session wait for its
|
||||||
|
line-reader to go would be enough, but the multiple nested
|
||||||
|
during/spawns creating the sessions mean that no matter how long
|
||||||
|
the old session instance sticks around, a new session will appear
|
||||||
|
before we're ready! ... maybe there's no way *at all* to
|
||||||
|
disambiguate old/new instances without, say, a unique
|
||||||
|
listener-socket identifier??
|
|
@ -0,0 +1,24 @@
|
||||||
|
#lang syndicate
|
||||||
|
|
||||||
|
(require "protocol.rkt")
|
||||||
|
(require "message.rkt")
|
||||||
|
|
||||||
|
(require/activate syndicate/reload)
|
||||||
|
|
||||||
|
(spawn #:name 'channel-factory
|
||||||
|
(stop-when-reloaded)
|
||||||
|
(during/spawn (ircd-channel-member $Ch _)
|
||||||
|
#:name `(ircd-channel ,Ch)
|
||||||
|
(field [topic #f])
|
||||||
|
(assert (ircd-channel-topic Ch (topic)))
|
||||||
|
|
||||||
|
(on (message (ircd-action $who (irc-message _ "MODE" (list Ch "b") _)))
|
||||||
|
(send! (ircd-event who (irc-message server-prefix 368 (list (lookup-nick who) Ch)
|
||||||
|
"End of Channel Ban List"))))
|
||||||
|
|
||||||
|
(on (message (ircd-action $who (irc-message _ "MODE" (list Ch) _)))
|
||||||
|
(send! (ircd-event who (irc-message server-prefix 324
|
||||||
|
(list (lookup-nick who) Ch "+") #f))))
|
||||||
|
|
||||||
|
(on (message (ircd-action _ (irc-message _ "TOPIC" (list Ch) $new-topic)))
|
||||||
|
(topic new-topic))))
|
|
@ -0,0 +1,14 @@
|
||||||
|
#lang syndicate
|
||||||
|
|
||||||
|
(require/activate syndicate/reload)
|
||||||
|
(require/activate syndicate/supervise)
|
||||||
|
(require/activate syndicate/drivers/config)
|
||||||
|
|
||||||
|
(require "protocol.rkt")
|
||||||
|
|
||||||
|
(spawn #:name 'config
|
||||||
|
(stop-when-reloaded)
|
||||||
|
|
||||||
|
(assert (ircd-motd (list "Hello, world!")))
|
||||||
|
|
||||||
|
(assert (ircd-listener 6667)))
|
|
@ -0,0 +1,7 @@
|
||||||
|
#lang syndicate
|
||||||
|
|
||||||
|
(require/activate syndicate/reload)
|
||||||
|
|
||||||
|
(spawn-reloader "config.rkt")
|
||||||
|
(spawn-reloader "session.rkt")
|
||||||
|
(spawn-reloader "channel.rkt")
|
|
@ -0,0 +1,93 @@
|
||||||
|
#lang racket/base
|
||||||
|
|
||||||
|
(provide (struct-out irc-message)
|
||||||
|
(struct-out irc-user)
|
||||||
|
(struct-out irc-privmsg)
|
||||||
|
|
||||||
|
(struct-out irc-source-servername)
|
||||||
|
(struct-out irc-source-nick)
|
||||||
|
|
||||||
|
parse-irc-message
|
||||||
|
render-irc-message
|
||||||
|
|
||||||
|
;; TODO make these assertions in the dataspace:
|
||||||
|
server-name
|
||||||
|
server-prefix)
|
||||||
|
|
||||||
|
(require racket/string)
|
||||||
|
(require racket/match)
|
||||||
|
(require racket/format)
|
||||||
|
|
||||||
|
;; <message> ::= [':' <prefix> <SPACE> ] <command> <params> <crlf>
|
||||||
|
;; <prefix> ::= <servername> | <nick> [ '!' <user> ] [ '@' <host> ]
|
||||||
|
;; <command> ::= <letter> { <letter> } | <number> <number> <number>
|
||||||
|
;; <SPACE> ::= ' ' { ' ' }
|
||||||
|
;; <params> ::= <SPACE> [ ':' <trailing> | <middle> <params> ]
|
||||||
|
;;
|
||||||
|
;; <middle> ::= <Any *non-empty* sequence of octets not including SPACE
|
||||||
|
;; or NUL or CR or LF, the first of which may not be ':'>
|
||||||
|
;; <trailing> ::= <Any, possibly *empty*, sequence of octets not including
|
||||||
|
;; NUL or CR or LF>
|
||||||
|
;;
|
||||||
|
;; <crlf> ::= CR LF
|
||||||
|
|
||||||
|
;; <target> ::= <to> [ "," <target> ]
|
||||||
|
;; <to> ::= <channel> | <user> '@' <servername> | <nick> | <mask>
|
||||||
|
;; <channel> ::= ('#' | '&') <chstring>
|
||||||
|
;; <servername> ::= <host>
|
||||||
|
;; <host> ::= see RFC 952 [DNS:4] for details on allowed hostnames
|
||||||
|
;; <nick> ::= <letter> { <letter> | <number> | <special> }
|
||||||
|
;; <mask> ::= ('#' | '$') <chstring>
|
||||||
|
;; <chstring> ::= <any 8bit code except SPACE, BELL, NUL, CR, LF and
|
||||||
|
;; comma (',')>
|
||||||
|
|
||||||
|
;; <user> ::= <nonwhite> { <nonwhite> }
|
||||||
|
;; <letter> ::= 'a' ... 'z' | 'A' ... 'Z'
|
||||||
|
;; <number> ::= '0' ... '9'
|
||||||
|
;; <special> ::= '-' | '[' | ']' | '\' | '`' | '^' | '{' | '}'
|
||||||
|
|
||||||
|
;; <nonwhite> ::= <any 8bit code except SPACE (0x20), NUL (0x0), CR
|
||||||
|
;; (0xd), and LF (0xa)>
|
||||||
|
|
||||||
|
(struct irc-message (prefix command params trailing) #:prefab)
|
||||||
|
(struct irc-user (username hostname realname) #:prefab)
|
||||||
|
(struct irc-privmsg (source target text) #:prefab)
|
||||||
|
|
||||||
|
(struct irc-source-servername (servername) #:prefab)
|
||||||
|
(struct irc-source-nick (nick user) #:prefab)
|
||||||
|
|
||||||
|
(define (parse-irc-message line0)
|
||||||
|
(match (string-trim #:left? #f line0 #px"[\r\n]")
|
||||||
|
[(pregexp #px"^:([^ ]+) +(.*)$" (list _ prefix rest)) (parse-command prefix rest)]
|
||||||
|
[line (parse-command #f line)]))
|
||||||
|
|
||||||
|
(define (parse-command prefix line)
|
||||||
|
(match-define (pregexp #px"^([^ ]+)( +([^:]+)?(:(.*))?)?$" (list _ command _ params _ rest)) line)
|
||||||
|
(irc-message prefix
|
||||||
|
(string-upcase command)
|
||||||
|
(string-split (or params ""))
|
||||||
|
rest))
|
||||||
|
|
||||||
|
;; libpurple's irc protocol support crashes (!) (SIGSEGV) if you send
|
||||||
|
;; a prefix on a JOIN event from the server as just "nick" rather than
|
||||||
|
;; "nick!user@host" - specifically, it will crash if "!" doesn't
|
||||||
|
;; appear in the prefix.
|
||||||
|
;;
|
||||||
|
(define (render-irc-message m)
|
||||||
|
(match-define (irc-message prefix command params trailing) m)
|
||||||
|
(string-append (render-prefix prefix)
|
||||||
|
(~a command)
|
||||||
|
(if (pair? params) (string-append " " (string-join (map ~a params))) "")
|
||||||
|
(if trailing (string-append " :" trailing) "")))
|
||||||
|
|
||||||
|
(define (render-prefix p)
|
||||||
|
(match p
|
||||||
|
[#f
|
||||||
|
""]
|
||||||
|
[(irc-source-servername servername)
|
||||||
|
(format ":~a " servername)]
|
||||||
|
[(irc-source-nick nick (irc-user username hostname _))
|
||||||
|
(format ":~a!~a@~a " nick username hostname)]))
|
||||||
|
|
||||||
|
(define server-name "syndicate-ircd")
|
||||||
|
(define server-prefix (irc-source-servername "syndicate-ircd.example"))
|
|
@ -0,0 +1,30 @@
|
||||||
|
#lang syndicate
|
||||||
|
|
||||||
|
(provide (struct-out ircd-listener)
|
||||||
|
(struct-out ircd-motd)
|
||||||
|
|
||||||
|
(struct-out ircd-connection-info)
|
||||||
|
(struct-out ircd-channel-member)
|
||||||
|
(struct-out ircd-channel-topic)
|
||||||
|
|
||||||
|
(struct-out ircd-action)
|
||||||
|
(struct-out ircd-event)
|
||||||
|
|
||||||
|
lookup-nick)
|
||||||
|
|
||||||
|
;; A Connection is a TcpAddress
|
||||||
|
|
||||||
|
(struct ircd-listener (port) #:prefab) ;; assertion
|
||||||
|
(struct ircd-motd (lines) #:prefab) ;; assertion
|
||||||
|
|
||||||
|
(struct ircd-connection-info (conn nick user) #:prefab) ;;assertion
|
||||||
|
(struct ircd-channel-member (channel conn) #:prefab) ;; assertion
|
||||||
|
(struct ircd-channel-topic (channel topic) #:prefab) ;; assertion
|
||||||
|
|
||||||
|
(struct ircd-action (conn message) #:prefab) ;; message
|
||||||
|
(struct ircd-event (conn message) #:prefab) ;; message
|
||||||
|
|
||||||
|
;;---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
(define (lookup-nick conn)
|
||||||
|
(immediate-query [query-value #f (ircd-connection-info conn $N _) N]))
|
|
@ -0,0 +1,177 @@
|
||||||
|
#lang syndicate
|
||||||
|
|
||||||
|
(require racket/set)
|
||||||
|
(require racket/string)
|
||||||
|
|
||||||
|
(require "protocol.rkt")
|
||||||
|
(require "message.rkt")
|
||||||
|
|
||||||
|
(require/activate syndicate/reload)
|
||||||
|
(require/activate syndicate/drivers/tcp)
|
||||||
|
(require/activate syndicate/drivers/line-reader)
|
||||||
|
(require syndicate/protocol/advertise)
|
||||||
|
(require syndicate/support/hash)
|
||||||
|
|
||||||
|
(define (ircd-connection-facet this-conn server-handle)
|
||||||
|
(define (send-to-remote #:newline [with-newline #t] fmt . vs)
|
||||||
|
(define bs (string->bytes/utf-8 (apply format fmt vs)))
|
||||||
|
(log-info "~a <- ~v" this-conn bs)
|
||||||
|
(send! (tcp-channel server-handle this-conn (if with-newline (bytes-append bs #"\r\n") bs))))
|
||||||
|
|
||||||
|
(define (send-irc-message m)
|
||||||
|
(send-to-remote "~a" (render-irc-message m)))
|
||||||
|
|
||||||
|
(define (send* #:source [prefix server-prefix] #:trailing [trailing #f] command . params)
|
||||||
|
(send-irc-message (irc-message prefix command params trailing)))
|
||||||
|
|
||||||
|
(on-start (log-info "Connecting ~a" this-conn))
|
||||||
|
(on-stop (log-info "Disconnecting ~a" this-conn))
|
||||||
|
|
||||||
|
(field [nick #f]
|
||||||
|
[user #f])
|
||||||
|
(define/dataflow conn-info (ircd-connection-info this-conn (nick) (user)))
|
||||||
|
(assert (conn-info))
|
||||||
|
|
||||||
|
(on-start
|
||||||
|
(react
|
||||||
|
(stop-when (asserted (ircd-motd $motd-lines))
|
||||||
|
(react
|
||||||
|
(begin/dataflow
|
||||||
|
(when (and (nick) (user))
|
||||||
|
(send* 375 (nick) #:trailing (format "- ~a Message of the day - " server-name))
|
||||||
|
(for [(line motd-lines)] (send* 372 (nick) #:trailing (format "- ~a" line)))
|
||||||
|
(send* 376 (nick) #:trailing (format "End of /MOTD command"))
|
||||||
|
(stop-current-facet)))))))
|
||||||
|
|
||||||
|
(field [peer-common-channels (hash)]
|
||||||
|
[peer-names (hash)])
|
||||||
|
|
||||||
|
(during (ircd-channel-member $Ch this-conn)
|
||||||
|
(field [initial-names-sent? #f]
|
||||||
|
[initial-member-nicks (set)])
|
||||||
|
|
||||||
|
(on-start (send* #:source (irc-source-nick (nick) (user)) "JOIN" Ch)
|
||||||
|
(flush!)
|
||||||
|
(flush!)
|
||||||
|
(define nicks (initial-member-nicks))
|
||||||
|
(initial-names-sent? #t)
|
||||||
|
(initial-member-nicks 'no-longer-valid)
|
||||||
|
(send* 353 (nick) "@" Ch #:trailing (string-join (set->list nicks)))
|
||||||
|
(send* 366 (nick) Ch #:trailing "End of /NAMES list"))
|
||||||
|
|
||||||
|
(during (ircd-channel-member Ch $other-conn)
|
||||||
|
(on-start (peer-common-channels (hashset-add (peer-common-channels) other-conn Ch)))
|
||||||
|
(on-stop (peer-common-channels (hashset-remove (peer-common-channels) other-conn Ch)))
|
||||||
|
(field [current-other-source #f])
|
||||||
|
(define/query-value next-other-source #f
|
||||||
|
(ircd-connection-info other-conn $N $U)
|
||||||
|
(irc-source-nick N U))
|
||||||
|
(on (retracted (ircd-channel-member Ch other-conn))
|
||||||
|
(when (current-other-source) (send* #:source (current-other-source) "PART" Ch)))
|
||||||
|
(on-stop (when (not (hash-has-key? (peer-common-channels) other-conn))
|
||||||
|
(peer-names (hash-remove (peer-names) other-conn))))
|
||||||
|
(begin/dataflow
|
||||||
|
(when (not (equal? (current-other-source) (next-other-source)))
|
||||||
|
(if (not (next-other-source)) ;; other-conn is disconnecting
|
||||||
|
(when (hash-ref (peer-names) other-conn #f)
|
||||||
|
(send* #:source (current-other-source) "QUIT")
|
||||||
|
(peer-names (hash-remove (peer-names) other-conn)))
|
||||||
|
(begin
|
||||||
|
(cond
|
||||||
|
[(not (initial-names-sent?)) ;; still gathering data for 353/366 below
|
||||||
|
(initial-member-nicks (set-add (initial-member-nicks)
|
||||||
|
(irc-source-nick-nick (next-other-source))))]
|
||||||
|
[(not (current-other-source)) ;; other-conn is joining
|
||||||
|
(send* #:source (next-other-source) "JOIN" Ch)]
|
||||||
|
[else ;; it's a nick change
|
||||||
|
(when (not (equal? this-conn other-conn)) ;; avoid dups for our own connection
|
||||||
|
(when (not (equal? (next-other-source) (hash-ref (peer-names) other-conn #f)))
|
||||||
|
(send* #:source (current-other-source) "NICK"
|
||||||
|
(irc-source-nick-nick (next-other-source)))))])
|
||||||
|
(peer-names (hash-set (peer-names) other-conn (next-other-source)))))
|
||||||
|
(current-other-source (next-other-source)))))
|
||||||
|
|
||||||
|
(on (asserted (ircd-channel-topic Ch $topic))
|
||||||
|
(if topic
|
||||||
|
(send* 332 (nick) Ch #:trailing topic)
|
||||||
|
(send* 331 (nick) Ch #:trailing "No topic is set")))
|
||||||
|
|
||||||
|
(on (message (ircd-action this-conn (irc-message _ "WHO" (list Ch) _)))
|
||||||
|
(flush!) ;; Wait for responses to come in. GROSS and not in
|
||||||
|
;; general correct (e.g. in the presence of
|
||||||
|
;; pipelining)
|
||||||
|
(send! (ircd-event this-conn
|
||||||
|
(irc-message server-prefix 315 (list (nick) Ch) "End of WHO list."))))
|
||||||
|
(on (message (ircd-action $who (irc-message _ "WHO" (list Ch) _)))
|
||||||
|
(match-define (irc-user U H R) (user))
|
||||||
|
(send! (ircd-event who (irc-message server-prefix 352
|
||||||
|
(list (nick) Ch U H server-name (nick) "H")
|
||||||
|
(format "0 ~a" R)))))
|
||||||
|
|
||||||
|
(on (message (ircd-action $other-conn (irc-privmsg $source Ch $text)))
|
||||||
|
(when (not (equal? other-conn this-conn))
|
||||||
|
(send* #:source source "PRIVMSG" Ch #:trailing text))))
|
||||||
|
|
||||||
|
(on (message (ircd-event this-conn $m))
|
||||||
|
(send-irc-message m))
|
||||||
|
|
||||||
|
(on (message (ircd-action $other-conn (irc-privmsg $source (nick) $text)))
|
||||||
|
(when (not (equal? other-conn this-conn))
|
||||||
|
(send* #:source source "PRIVMSG" (nick) #:trailing text)))
|
||||||
|
|
||||||
|
(on (message (tcp-channel-line this-conn server-handle $bs))
|
||||||
|
(define m (parse-irc-message (bytes->string/utf-8 bs)))
|
||||||
|
(log-info "~a -> ~v" this-conn m)
|
||||||
|
(send! (ircd-action this-conn m))
|
||||||
|
(match m
|
||||||
|
[(irc-message _ "PING" _ _) (void)] ;; RFC says servers don't reply to PINGs
|
||||||
|
[(or (irc-message _ "NICK" (list N) _)
|
||||||
|
(irc-message _ "NICK" '() N)) ;; libpurple does this (!)
|
||||||
|
;; TODO: enforce syntactic restrictions on nick
|
||||||
|
(if (immediate-query [query-value #f (ircd-connection-info _ N _) #t])
|
||||||
|
(send* 433 N #:trailing "Nickname is already in use")
|
||||||
|
(begin (when (nick) (send* #:source (irc-source-nick (nick) (user)) "NICK" N))
|
||||||
|
(nick N)))]
|
||||||
|
[(irc-message _ "USER" (list U _Hostname _Servername) R)
|
||||||
|
;; TODO: enforce syntactic restrictions on parameters to USER
|
||||||
|
(define H (tcp-address-host this-conn))
|
||||||
|
(user (irc-user U H R))]
|
||||||
|
[(irc-message _ "QUIT" _ _) (stop-current-facet)]
|
||||||
|
[_
|
||||||
|
(when (and (nick) (user))
|
||||||
|
(match m
|
||||||
|
[(irc-message _ "JOIN" (cons Channels _MaybeKeys) _)
|
||||||
|
(for [(Ch (string-split Channels #px",+"))]
|
||||||
|
(assert! (ircd-channel-member Ch this-conn)))]
|
||||||
|
[(irc-message _ "PART" (list Channels) _)
|
||||||
|
(for [(Ch (string-split Channels #px",+"))]
|
||||||
|
(retract! (ircd-channel-member Ch this-conn)))]
|
||||||
|
[(irc-message _ "WHOIS" _ _)
|
||||||
|
(send* 318 (nick) #:trailing "End of /WHOIS list")] ;; TODO
|
||||||
|
[(irc-message _ "PRIVMSG" (list Targets) Text)
|
||||||
|
(for [(T (string-split Targets #px",+"))]
|
||||||
|
(send! (ircd-action this-conn
|
||||||
|
(irc-privmsg (irc-source-nick (nick) (user)) T Text))))]
|
||||||
|
[_ (void)]))])))
|
||||||
|
|
||||||
|
(spawn #:name 'ison-responder
|
||||||
|
(stop-when-reloaded)
|
||||||
|
(define/query-set nicks (ircd-connection-info _ $N _) N)
|
||||||
|
(on (message (ircd-action $conn (irc-message _ "ISON" $SomeNicks $MoreNicks)))
|
||||||
|
(define Nicks (append SomeNicks (string-split (or MoreNicks ""))))
|
||||||
|
(define (on? N) (set-member? (nicks) N))
|
||||||
|
(define Present (string-join (filter on? Nicks) " "))
|
||||||
|
(send! (ircd-event conn (irc-message server-prefix 303 '("*") Present)))))
|
||||||
|
|
||||||
|
(spawn #:name 'session-listener-factory
|
||||||
|
(stop-when-reloaded)
|
||||||
|
(during/spawn (ircd-listener $port)
|
||||||
|
#:name (ircd-listener port)
|
||||||
|
(on-start (log-info "Listening on port ~a." port))
|
||||||
|
(on-stop (log-info "No longer listening on port ~a." port))
|
||||||
|
(define server-handle (tcp-listener port))
|
||||||
|
(assert (advertise (observe (tcp-channel _ server-handle _))))
|
||||||
|
(during/spawn (advertise (tcp-channel $this-conn server-handle _))
|
||||||
|
#:name `(ircd-connection ,this-conn ,server-handle)
|
||||||
|
(assert (advertise (tcp-channel server-handle this-conn _)))
|
||||||
|
(ircd-connection-facet this-conn server-handle))))
|
|
@ -5,3 +5,8 @@ run:
|
||||||
|
|
||||||
clean:
|
clean:
|
||||||
find . -name compiled -type d | xargs rm -rf
|
find . -name compiled -type d | xargs rm -rf
|
||||||
|
rm -f cpingresp
|
||||||
|
|
||||||
|
cpingresp: cpingresp.c
|
||||||
|
$(CC) -o $@ $<
|
||||||
|
sudo setcap cap_net_raw+p+i+e $@
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
#lang syndicate/actor
|
#lang syndicate
|
||||||
;; ARP protocol, http://tools.ietf.org/html/rfc826
|
;; ARP protocol, http://tools.ietf.org/html/rfc826
|
||||||
;; Only does ARP-over-ethernet.
|
;; Only does ARP-over-ethernet.
|
||||||
|
|
||||||
|
@ -29,8 +29,8 @@
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(define (spawn-arp-driver)
|
(define (spawn-arp-driver)
|
||||||
(actor #:name 'arp-driver
|
(spawn #:name 'arp-driver
|
||||||
(during/actor (arp-interface $interface-name)
|
(during/spawn (arp-interface $interface-name)
|
||||||
#:name (list 'arp-interface interface-name)
|
#:name (list 'arp-interface interface-name)
|
||||||
(assert (arp-interface-up interface-name))
|
(assert (arp-interface-up interface-name))
|
||||||
(on-start (define hwaddr (lookup-ethernet-hwaddr interface-name))
|
(on-start (define hwaddr (lookup-ethernet-hwaddr interface-name))
|
||||||
|
|
|
@ -0,0 +1,219 @@
|
||||||
|
#include <stdio.h>
|
||||||
|
#include <stdlib.h>
|
||||||
|
#include <string.h>
|
||||||
|
#include <stdint.h>
|
||||||
|
#include <ctype.h>
|
||||||
|
|
||||||
|
#include <sys/types.h>
|
||||||
|
#include <sys/socket.h>
|
||||||
|
#include <sys/time.h>
|
||||||
|
#include <sys/ioctl.h>
|
||||||
|
|
||||||
|
#include <fcntl.h>
|
||||||
|
#include <err.h>
|
||||||
|
#include <errno.h>
|
||||||
|
#include <unistd.h>
|
||||||
|
#include <ifaddrs.h>
|
||||||
|
|
||||||
|
#include <net/if.h>
|
||||||
|
#include <net/ethernet.h>
|
||||||
|
#include <arpa/inet.h> /* for htons */
|
||||||
|
|
||||||
|
#include <pthread.h>
|
||||||
|
|
||||||
|
#include <net/if_arp.h>
|
||||||
|
#include <netpacket/packet.h>
|
||||||
|
|
||||||
|
static int lookupInterfaceInfo(int sock, char const *interfaceName, int info, struct ifreq *ifr) {
|
||||||
|
strncpy(ifr->ifr_name, interfaceName, IFNAMSIZ);
|
||||||
|
if (ioctl(sock, info, ifr) < 0) {
|
||||||
|
perror("ioctl error while looking performing ioctl on interface");
|
||||||
|
fprintf(stderr, "(ioctl number 0x%08x, interface %s)\n", info, interfaceName);
|
||||||
|
return -1;
|
||||||
|
} else {
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
static int bindToInterface(int sock, char const *interfaceName) {
|
||||||
|
struct ifreq ifr;
|
||||||
|
struct sockaddr_ll socketAddress;
|
||||||
|
|
||||||
|
if (lookupInterfaceInfo(sock, interfaceName, SIOCGIFINDEX, &ifr) < 0) {
|
||||||
|
return -1;
|
||||||
|
}
|
||||||
|
|
||||||
|
socketAddress.sll_family = AF_PACKET;
|
||||||
|
socketAddress.sll_protocol = htons(ETH_P_ALL);
|
||||||
|
socketAddress.sll_ifindex = ifr.ifr_ifindex;
|
||||||
|
|
||||||
|
if (bind(sock, (struct sockaddr *) &socketAddress, sizeof(socketAddress)) < 0) {
|
||||||
|
perror("Bind error");
|
||||||
|
return -1;
|
||||||
|
}
|
||||||
|
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
static int openSocket(char const *interfaceName) {
|
||||||
|
int sock = socket(AF_PACKET, SOCK_RAW, htons(ETH_P_ALL));
|
||||||
|
if (sock < 0) {
|
||||||
|
perror("Socket error");
|
||||||
|
return -1;
|
||||||
|
}
|
||||||
|
|
||||||
|
if (bindToInterface(sock, interfaceName) == -1) {
|
||||||
|
return -1;
|
||||||
|
}
|
||||||
|
|
||||||
|
return sock;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* hwaddr should be of length ETH_ALEN */
|
||||||
|
static int socket_hwaddr(int sock, char const *interfaceName, char *hwaddr) {
|
||||||
|
struct ifreq ifr;
|
||||||
|
|
||||||
|
if (lookupInterfaceInfo(sock, interfaceName, SIOCGIFHWADDR, &ifr) < 0) {
|
||||||
|
return -1;
|
||||||
|
}
|
||||||
|
|
||||||
|
if (ifr.ifr_hwaddr.sa_family != ARPHRD_ETHER) {
|
||||||
|
return -1;
|
||||||
|
}
|
||||||
|
|
||||||
|
memcpy(hwaddr, ifr.ifr_hwaddr.sa_data, ETH_ALEN);
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
static void dump_row(long count, int numinrow, int *chs) {
|
||||||
|
int i;
|
||||||
|
|
||||||
|
printf("%08lX:", count - numinrow);
|
||||||
|
|
||||||
|
if (numinrow > 0) {
|
||||||
|
for (i = 0; i < numinrow; i++) {
|
||||||
|
if (i == 8)
|
||||||
|
printf(" :");
|
||||||
|
printf(" %02X", chs[i]);
|
||||||
|
}
|
||||||
|
for (i = numinrow; i < 16; i++) {
|
||||||
|
if (i == 8)
|
||||||
|
printf(" :");
|
||||||
|
printf(" ");
|
||||||
|
}
|
||||||
|
printf(" ");
|
||||||
|
for (i = 0; i < numinrow; i++) {
|
||||||
|
if (isprint(chs[i]))
|
||||||
|
printf("%c", chs[i]);
|
||||||
|
else
|
||||||
|
printf(".");
|
||||||
|
}
|
||||||
|
}
|
||||||
|
printf("\n");
|
||||||
|
}
|
||||||
|
|
||||||
|
static int rows_eq(int *a, int *b) {
|
||||||
|
int i;
|
||||||
|
|
||||||
|
for (i=0; i<16; i++)
|
||||||
|
if (a[i] != b[i])
|
||||||
|
return 0;
|
||||||
|
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
void dump_buffer_to_stdout(void *buf_v, int len, int hexmode) {
|
||||||
|
unsigned char *buf = (unsigned char *) buf_v;
|
||||||
|
long count = 0;
|
||||||
|
int numinrow = 0;
|
||||||
|
int chs[16];
|
||||||
|
int oldchs[16];
|
||||||
|
int showed_dots = 0;
|
||||||
|
int i;
|
||||||
|
|
||||||
|
if (hexmode) {
|
||||||
|
for (i = 0; i < len; i++) {
|
||||||
|
int ch = buf[i];
|
||||||
|
|
||||||
|
if (numinrow == 16) {
|
||||||
|
int i;
|
||||||
|
|
||||||
|
if (rows_eq(oldchs, chs)) {
|
||||||
|
if (!showed_dots) {
|
||||||
|
showed_dots = 1;
|
||||||
|
printf(" .. .. .. .. .. .. .. .. : .. .. .. .. .. .. .. ..\n");
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
showed_dots = 0;
|
||||||
|
dump_row(count, numinrow, chs);
|
||||||
|
}
|
||||||
|
|
||||||
|
for (i=0; i<16; i++)
|
||||||
|
oldchs[i] = chs[i];
|
||||||
|
|
||||||
|
numinrow = 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
count++;
|
||||||
|
chs[numinrow++] = ch;
|
||||||
|
}
|
||||||
|
|
||||||
|
dump_row(count, numinrow, chs);
|
||||||
|
|
||||||
|
if (numinrow != 0)
|
||||||
|
printf("%08lX:\n", count);
|
||||||
|
} else {
|
||||||
|
fwrite(buf, 1, len, stdout);
|
||||||
|
printf("\n");
|
||||||
|
fflush(NULL);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
int main(int argc, char const *argv[]) {
|
||||||
|
int handle = openSocket("eth0");
|
||||||
|
uint8_t buf[65536];
|
||||||
|
|
||||||
|
while (1) {
|
||||||
|
ssize_t len = recv(handle, &buf[0], sizeof(buf), MSG_TRUNC);
|
||||||
|
if (len == -1) {
|
||||||
|
perror("recv");
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
|
||||||
|
uint8_t *ipbuf = buf + 14;
|
||||||
|
|
||||||
|
uint32_t self_ip = 0x810a735e;
|
||||||
|
|
||||||
|
uint32_t remote_ip = ntohl(*(int *)(&ipbuf[12]));
|
||||||
|
uint32_t local_ip = ntohl(*(int *)(&ipbuf[16]));
|
||||||
|
|
||||||
|
if (local_ip == self_ip) {
|
||||||
|
printf("Got ping from %d.%d.%d.%d\n", ipbuf[12], ipbuf[13], ipbuf[14], ipbuf[15]);
|
||||||
|
if ((len >= 28) && (ipbuf[9] == 1) && (ipbuf[20] == 8)) {
|
||||||
|
ipbuf[20] = 0;
|
||||||
|
{
|
||||||
|
short *icmp_cksum = (short *) (&ipbuf[22]);
|
||||||
|
*icmp_cksum = htons(ntohs(*icmp_cksum) + 0x0800);
|
||||||
|
}
|
||||||
|
*(int *)(&ipbuf[12]) = htonl(local_ip);
|
||||||
|
*(int *)(&ipbuf[16]) = htonl(remote_ip);
|
||||||
|
|
||||||
|
{
|
||||||
|
uint8_t mac[6];
|
||||||
|
memcpy(mac, buf, 6);
|
||||||
|
memcpy(buf, buf+6, 6);
|
||||||
|
memcpy(buf+6, mac, 6);
|
||||||
|
}
|
||||||
|
{
|
||||||
|
ssize_t written = write(handle, buf, len);
|
||||||
|
if (written != len) {
|
||||||
|
perror("write");
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
return 0;
|
||||||
|
}
|
|
@ -1,20 +1,21 @@
|
||||||
#lang syndicate/actor
|
#lang syndicate
|
||||||
;; Demonstration stack configuration for various hosts.
|
;; Demonstration stack configuration for various hosts.
|
||||||
|
|
||||||
(require racket/match)
|
(require racket/match)
|
||||||
(require (only-in mzlib/os gethostname))
|
(require (only-in mzlib/os gethostname))
|
||||||
|
(require (only-in racket/string string-split))
|
||||||
(require "configuration.rkt")
|
(require "configuration.rkt")
|
||||||
|
|
||||||
(actor
|
(spawn
|
||||||
(match (gethostname)
|
(match (gethostname)
|
||||||
["skip"
|
|
||||||
(assert (gateway-route (bytes 0 0 0 0) 0 (bytes 192 168 1 1) "en0"))
|
|
||||||
(assert (host-route (bytes 192 168 1 222) 24 "en0"))]
|
|
||||||
[(or "hop" "walk")
|
|
||||||
(assert (gateway-route (bytes 0 0 0 0) 0 (bytes 192 168 1 1) "wlan0"))
|
|
||||||
(assert (host-route (bytes 192 168 1 222) 24 "wlan0"))]
|
|
||||||
["stockholm.ccs.neu.edu"
|
["stockholm.ccs.neu.edu"
|
||||||
(assert (host-route (bytes 129 10 115 94) 24 "eth0"))
|
(assert (host-route (bytes 129 10 115 94) 24 "eth0"))
|
||||||
(assert (gateway-route (bytes 0 0 0 0) 0 (bytes 129 10 115 1) "eth0"))]
|
(assert (gateway-route (bytes 0 0 0 0) 0 (bytes 129 10 115 1) "eth0"))]
|
||||||
[other
|
[other ;; assume a private network
|
||||||
(error 'demo-config "No setup for hostname ~a" other)]))
|
(define interface
|
||||||
|
(match (car (string-split other "."))
|
||||||
|
["skip" "en0"]
|
||||||
|
["leap" "wlp4s0"] ;; wtf
|
||||||
|
[_ "wlan0"]))
|
||||||
|
(assert (gateway-route (bytes 0 0 0 0) 0 (bytes 192 168 1 1) interface))
|
||||||
|
(assert (host-route (bytes 192 168 1 222) 24 interface))]))
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
#lang syndicate/actor
|
#lang syndicate
|
||||||
;; Ethernet driver
|
;; Ethernet driver
|
||||||
|
|
||||||
(provide (struct-out ethernet-packet)
|
(provide (struct-out ethernet-packet)
|
||||||
|
@ -29,8 +29,8 @@
|
||||||
(log-info "Device names: ~a" interface-names)
|
(log-info "Device names: ~a" interface-names)
|
||||||
|
|
||||||
(define (spawn-ethernet-driver)
|
(define (spawn-ethernet-driver)
|
||||||
(actor #:name 'ethernet-driver
|
(spawn #:name 'ethernet-driver
|
||||||
(during/actor
|
(during/spawn
|
||||||
(observe (ethernet-packet (ethernet-interface $interface-name _) #t _ _ _ _))
|
(observe (ethernet-packet (ethernet-interface $interface-name _) #t _ _ _ _))
|
||||||
#:name (list 'ethernet-interface interface-name)
|
#:name (list 'ethernet-interface interface-name)
|
||||||
|
|
||||||
|
@ -46,7 +46,7 @@
|
||||||
|
|
||||||
(on-start (flush!) ;; ensure all subscriptions are in place
|
(on-start (flush!) ;; ensure all subscriptions are in place
|
||||||
(async-channel-put control-ch 'unblock)
|
(async-channel-put control-ch 'unblock)
|
||||||
(actor #:name (list 'ethernet-interface-quit-monitor interface-name)
|
(spawn #:name (list 'ethernet-interface-quit-monitor interface-name)
|
||||||
(on (retracted interface)
|
(on (retracted interface)
|
||||||
(async-channel-put control-ch 'quit))))
|
(async-channel-put control-ch 'quit))))
|
||||||
|
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
#lang syndicate/actor
|
#lang syndicate
|
||||||
|
|
||||||
(require/activate syndicate/drivers/timer)
|
(require/activate syndicate/drivers/timer)
|
||||||
(require/activate "ethernet.rkt")
|
(require/activate "ethernet.rkt")
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
#lang syndicate/actor
|
#lang syndicate
|
||||||
|
|
||||||
(provide (struct-out ip-packet)
|
(provide (struct-out ip-packet)
|
||||||
ip-address->hostname
|
ip-address->hostname
|
||||||
|
@ -57,15 +57,15 @@
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(define (spawn-ip-driver)
|
(define (spawn-ip-driver)
|
||||||
(actor #:name 'ip-driver
|
(spawn #:name 'ip-driver
|
||||||
(during/actor (host-route $my-address $netmask $interface-name)
|
(during/spawn (host-route $my-address $netmask $interface-name)
|
||||||
(assert (route-up (host-route my-address netmask interface-name)))
|
(assert (route-up (host-route my-address netmask interface-name)))
|
||||||
(do-host-route my-address netmask interface-name))
|
(do-host-route my-address netmask interface-name))
|
||||||
(during/actor (gateway-route $network $netmask $gateway-addr $interface-name)
|
(during/spawn (gateway-route $network $netmask $gateway-addr $interface-name)
|
||||||
(assert (route-up
|
(assert (route-up
|
||||||
(gateway-route $network $netmask $gateway-addr $interface-name)))
|
(gateway-route $network $netmask $gateway-addr $interface-name)))
|
||||||
(do-gateway-route network netmask gateway-addr interface-name))
|
(do-gateway-route network netmask gateway-addr interface-name))
|
||||||
(during/actor (net-route $network-addr $netmask $link)
|
(during/spawn (net-route $network-addr $netmask $link)
|
||||||
(assert (route-up (net-route network-addr netmask link)))
|
(assert (route-up (net-route network-addr netmask link)))
|
||||||
(do-net-route network-addr netmask link))))
|
(do-net-route network-addr netmask link))))
|
||||||
|
|
||||||
|
@ -176,7 +176,9 @@
|
||||||
(when (and (not (equal? (ip-packet-source-interface p) interface-name))
|
(when (and (not (equal? (ip-packet-source-interface p) interface-name))
|
||||||
(ip-address-in-subnet? destination network netmask))
|
(ip-address-in-subnet? destination network netmask))
|
||||||
(define timer-id (gensym 'ippkt))
|
(define timer-id (gensym 'ippkt))
|
||||||
(react (on-start (send! (set-timer timer-id 5000 'relative)))
|
;; v Use `spawn` instead of `react` to avoid gratuitous packet
|
||||||
|
;; reordering.
|
||||||
|
(spawn (on-start (send! (set-timer timer-id 5000 'relative)))
|
||||||
(stop-when (message (timer-expired timer-id _))
|
(stop-when (message (timer-expired timer-id _))
|
||||||
(log-warning "ARP lookup of ~a failed, packet dropped"
|
(log-warning "ARP lookup of ~a failed, packet dropped"
|
||||||
(ip-address->hostname destination)))
|
(ip-address->hostname destination)))
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
#lang syndicate/actor
|
#lang syndicate
|
||||||
|
|
||||||
(require syndicate/protocol/advertise)
|
(require syndicate/protocol/advertise)
|
||||||
|
|
||||||
|
@ -19,7 +19,7 @@
|
||||||
(struct present (who) #:prefab)
|
(struct present (who) #:prefab)
|
||||||
|
|
||||||
(define (spawn-session them us)
|
(define (spawn-session them us)
|
||||||
(actor (define (send-to-remote fmt . vs)
|
(spawn (define (send-to-remote fmt . vs)
|
||||||
(send! (outbound (tcp-channel us them (string->bytes/utf-8 (apply format fmt vs))))))
|
(send! (outbound (tcp-channel us them (string->bytes/utf-8 (apply format fmt vs))))))
|
||||||
|
|
||||||
(define (say who fmt . vs)
|
(define (say who fmt . vs)
|
||||||
|
@ -41,33 +41,32 @@
|
||||||
(on (message (inbound (tcp-channel them us $bs)))
|
(on (message (inbound (tcp-channel them us $bs)))
|
||||||
(send! (says user (string-trim (bytes->string/utf-8 bs)))))))
|
(send! (says user (string-trim (bytes->string/utf-8 bs)))))))
|
||||||
|
|
||||||
(dataspace #:name 'chat-dataspace
|
|
||||||
(define us (tcp-listener 5999))
|
(define us (tcp-listener 5999))
|
||||||
(forever (assert (outbound (advertise (observe (tcp-channel _ us _)))))
|
(dataspace #:name 'chat-dataspace
|
||||||
|
(spawn #:name 'chat-server
|
||||||
|
(assert (outbound (advertise (observe (tcp-channel _ us _)))))
|
||||||
(on (asserted (inbound (advertise (tcp-channel $them us _))))
|
(on (asserted (inbound (advertise (tcp-channel $them us _))))
|
||||||
(spawn-session them us)))))
|
(spawn-session them us)))))
|
||||||
|
|
||||||
(let ((dst (udp-listener 6667)))
|
(let ((dst (udp-listener 6667)))
|
||||||
(actor #:name 'udp-echo-program
|
(spawn #:name 'udp-echo-program
|
||||||
(on (message (udp-packet $src dst $body))
|
(on (message (udp-packet $src dst $body))
|
||||||
(log-info "Got packet from ~v: ~v" src body)
|
(log-info "Got packet from ~v: ~v" src body)
|
||||||
(send! (udp-packet dst src (string->bytes/utf-8 (format "You said: ~a" body)))))))
|
(send! (udp-packet dst src (string->bytes/utf-8 (format "You said: ~a" body)))))))
|
||||||
|
|
||||||
(let ()
|
(let ()
|
||||||
(dataspace #:name 'webserver-dataspace
|
(dataspace #:name 'webserver-dataspace
|
||||||
(actor #:name 'webserver-counter
|
(spawn #:name 'webserver-counter
|
||||||
(field [counter 0])
|
(field [counter 0])
|
||||||
(on (message 'bump)
|
(on (message 'bump)
|
||||||
(send! `(counter ,(counter)))
|
(send! `(counter ,(counter)))
|
||||||
(counter (+ (counter) 1))))
|
(counter (+ (counter) 1))))
|
||||||
|
|
||||||
(forever (define us (tcp-listener 80))
|
(define us (tcp-listener 80))
|
||||||
(assert (outbound (advertise (observe (tcp-channel _ us _)))))
|
(spawn (assert (outbound (advertise (observe (tcp-channel _ us _)))))
|
||||||
(during/actor (inbound (advertise (tcp-channel ($ them (tcp-address _ _)) us _)))
|
(during/spawn (inbound (advertise (tcp-channel ($ them (tcp-address _ _)) us _)))
|
||||||
#:name (list 'webserver-session them)
|
#:name (list 'webserver-session them)
|
||||||
(log-info "Got connection from ~v" them)
|
(log-info "Got connection from ~v" them)
|
||||||
(field [done? #f])
|
|
||||||
(stop-when (rising-edge (done?)))
|
|
||||||
(assert (outbound (advertise (tcp-channel us them _))))
|
(assert (outbound (advertise (tcp-channel us them _))))
|
||||||
(on (message (inbound (tcp-channel them us _)))) ;; ignore input
|
(on (message (inbound (tcp-channel them us _)))) ;; ignore input
|
||||||
|
|
||||||
|
@ -76,7 +75,9 @@
|
||||||
(define response
|
(define response
|
||||||
(string->bytes/utf-8
|
(string->bytes/utf-8
|
||||||
(format (string-append
|
(format (string-append
|
||||||
"HTTP/1.0 200 OK\r\n\r\n"
|
"HTTP/1.0 200 OK\r\n"
|
||||||
|
"Content-Type: text/html\r\n"
|
||||||
|
"\r\n"
|
||||||
"<h1>Hello world from syndicate-netstack!</h1>\n"
|
"<h1>Hello world from syndicate-netstack!</h1>\n"
|
||||||
"<p>This is running on syndicate's own\n"
|
"<p>This is running on syndicate's own\n"
|
||||||
"<a href='https://github.com/tonyg/syndicate/'>\n"
|
"<a href='https://github.com/tonyg/syndicate/'>\n"
|
||||||
|
@ -84,4 +85,7 @@
|
||||||
"<p>There have been ~a requests prior to this one.</p>\n")
|
"<p>There have been ~a requests prior to this one.</p>\n")
|
||||||
counter)))
|
counter)))
|
||||||
(send! (outbound (tcp-channel us them response)))
|
(send! (outbound (tcp-channel us them response)))
|
||||||
(done? #t))))))
|
(for [(i 4)]
|
||||||
|
(define buf (make-bytes 1024 (+ #x30 i)))
|
||||||
|
(send! (outbound (tcp-channel us them buf))))
|
||||||
|
(stop-facet (current-facet-id)))))))
|
||||||
|
|
|
@ -0,0 +1,67 @@
|
||||||
|
#lang racket/base
|
||||||
|
;; Simple "ping" responder. Nightmarishly oversimplified. We want to
|
||||||
|
;; look at overheads excluding Syndicate. See also
|
||||||
|
;; http://dunkels.com/adam/twip.html
|
||||||
|
|
||||||
|
(require packet-socket)
|
||||||
|
|
||||||
|
(require "dump-bytes.rkt")
|
||||||
|
|
||||||
|
(define device-name (or (getenv "PINGRESP_DEVICE") "eth0"))
|
||||||
|
(define self-ip (integer-bytes->integer (bytes 129 10 115 94) #f #t))
|
||||||
|
|
||||||
|
(define handle (raw-interface-open device-name))
|
||||||
|
(unless handle (error 'pingresp "Couldn't open ~a" device-name))
|
||||||
|
|
||||||
|
(let loop ()
|
||||||
|
(define eth-buffer (raw-interface-read handle))
|
||||||
|
(define buffer (subbytes eth-buffer 14))
|
||||||
|
(when (>= (bytes-length buffer) 20) ;; enough space for local and remote IP addresses
|
||||||
|
(define local-ip (integer-bytes->integer buffer #f #t 16 20))
|
||||||
|
(define remote-ip (integer-bytes->integer buffer #f #t 12 16))
|
||||||
|
(when (= local-ip self-ip)
|
||||||
|
;; (printf "Got ping from ~v\n" (bytes->list (subbytes buffer 12 16)))
|
||||||
|
;; (flush-output)
|
||||||
|
;; (dump-bytes! eth-buffer)
|
||||||
|
;; (newline)
|
||||||
|
|
||||||
|
(when (and (>= (bytes-length buffer) 28) ;; IP + ICMP headers
|
||||||
|
(= (bytes-ref buffer 9) 1) ;; IP protocol
|
||||||
|
(= (bytes-ref buffer 20) 8) ;; ICMP ECHO
|
||||||
|
)
|
||||||
|
|
||||||
|
(bytes-set! buffer 20 0) ;; ICMP ECHO_REPLY
|
||||||
|
(integer->integer-bytes (bitwise-and #xffff
|
||||||
|
(+ #x0800
|
||||||
|
(integer-bytes->integer buffer #f #t 22 24)))
|
||||||
|
2 #f #t buffer 22) ;; "fix" checksum
|
||||||
|
(integer->integer-bytes local-ip 4 #f #t buffer 12)
|
||||||
|
(integer->integer-bytes remote-ip 4 #f #t buffer 16)
|
||||||
|
|
||||||
|
(define reply
|
||||||
|
(bytes-append (subbytes eth-buffer 6 12)
|
||||||
|
(subbytes eth-buffer 0 6)
|
||||||
|
(subbytes eth-buffer 12 14)
|
||||||
|
buffer))
|
||||||
|
;; (displayln "Reply:")
|
||||||
|
;; (dump-bytes! reply)
|
||||||
|
;; (newline)
|
||||||
|
(raw-interface-write handle reply))))
|
||||||
|
(loop))
|
||||||
|
|
||||||
|
(raw-interface-close handle)
|
||||||
|
|
||||||
|
|
||||||
|
;; short s[70];
|
||||||
|
;; int *l = s;
|
||||||
|
;; int t;
|
||||||
|
;;
|
||||||
|
;; read(0, s, 140);
|
||||||
|
;; if((s[4] & 65280) == 256 & s[10] == 8) {
|
||||||
|
;; s[10] = 0;
|
||||||
|
;; s[11] += 8;
|
||||||
|
;; t = l[4];
|
||||||
|
;; l[4] = l[3];
|
||||||
|
;; l[3] = t;
|
||||||
|
;; write(1, s, 140);
|
||||||
|
;; }
|
|
@ -1,4 +1,4 @@
|
||||||
#lang syndicate/actor
|
#lang syndicate
|
||||||
;; UDP/TCP port allocator
|
;; UDP/TCP port allocator
|
||||||
|
|
||||||
(provide spawn-port-allocator
|
(provide spawn-port-allocator
|
||||||
|
@ -13,7 +13,7 @@
|
||||||
(struct port-allocation-reply (reqid port) #:prefab)
|
(struct port-allocation-reply (reqid port) #:prefab)
|
||||||
|
|
||||||
(define (spawn-port-allocator allocator-type query-used-ports)
|
(define (spawn-port-allocator allocator-type query-used-ports)
|
||||||
(actor #:name (list 'port-allocator allocator-type)
|
(spawn #:name (list 'port-allocator allocator-type)
|
||||||
(define local-ips (query-local-ip-addresses))
|
(define local-ips (query-local-ip-addresses))
|
||||||
(define used-ports (query-used-ports))
|
(define used-ports (query-used-ports))
|
||||||
|
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
#lang syndicate/actor
|
#lang syndicate
|
||||||
|
|
||||||
(provide (struct-out tcp-address)
|
(provide (struct-out tcp-address)
|
||||||
(struct-out tcp-handle)
|
(struct-out tcp-handle)
|
||||||
|
@ -13,10 +13,14 @@
|
||||||
(require "dump-bytes.rkt")
|
(require "dump-bytes.rkt")
|
||||||
(require "checksum.rkt")
|
(require "checksum.rkt")
|
||||||
|
|
||||||
(require/activate syndicate/drivers/timer)
|
(require/activate syndicate/drivers/timestate)
|
||||||
(require "ip.rkt")
|
(require "ip.rkt")
|
||||||
(require "port-allocator.rkt")
|
(require "port-allocator.rkt")
|
||||||
|
|
||||||
|
(module+ test (require rackunit))
|
||||||
|
|
||||||
|
(define-logger netstack/tcp)
|
||||||
|
|
||||||
;; tcp-address/tcp-address : "kernel" tcp connection state machines
|
;; tcp-address/tcp-address : "kernel" tcp connection state machines
|
||||||
;; tcp-handle/tcp-address : "user" outbound connections
|
;; tcp-handle/tcp-address : "user" outbound connections
|
||||||
;; tcp-listener/tcp-address : "user" inbound connections
|
;; tcp-listener/tcp-address : "user" inbound connections
|
||||||
|
@ -46,14 +50,27 @@
|
||||||
;; (tcp-port-allocation Number (U TcpHandle TcpListener))
|
;; (tcp-port-allocation Number (U TcpHandle TcpListener))
|
||||||
(struct tcp-port-allocation (port handle) #:prefab)
|
(struct tcp-port-allocation (port handle) #:prefab)
|
||||||
|
|
||||||
|
(define (summarize-tcp-packet packet)
|
||||||
|
(format "(~a) ~a:~a -> ~a:~a (seq ~a, ack ~a, flags ~a, window ~a, payload ~a)"
|
||||||
|
(if (tcp-packet-from-wire? packet) "I" "O")
|
||||||
|
(ip-address->hostname (tcp-packet-source-ip packet))
|
||||||
|
(tcp-packet-source-port packet)
|
||||||
|
(ip-address->hostname (tcp-packet-destination-ip packet))
|
||||||
|
(tcp-packet-destination-port packet)
|
||||||
|
(tcp-packet-sequence-number packet)
|
||||||
|
(tcp-packet-ack-number packet)
|
||||||
|
(tcp-packet-flags packet)
|
||||||
|
(tcp-packet-window-size packet)
|
||||||
|
(bit-string-byte-count (tcp-packet-data packet))))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; User-accessible driver startup
|
;; User-accessible driver startup
|
||||||
|
|
||||||
(define (spawn-tcp-driver)
|
(define (spawn-tcp-driver)
|
||||||
(spawn-port-allocator 'tcp (lambda () (query-set tcp-ports (tcp-port-allocation $p _) p)))
|
(spawn-port-allocator 'tcp (lambda () (query-set tcp-ports (tcp-port-allocation $p _) p)))
|
||||||
(spawn-kernel-tcp-driver)
|
(spawn-kernel-tcp-driver)
|
||||||
(actor #:name 'tcp-inbound-driver
|
(spawn #:name 'tcp-inbound-driver
|
||||||
(during/actor (advertise (observe (tcp-channel _ ($ server-addr (tcp-listener _)) _)))
|
(during/spawn (advertise (observe (tcp-channel _ ($ server-addr (tcp-listener _)) _)))
|
||||||
#:name (list 'tcp-listen server-addr)
|
#:name (list 'tcp-listen server-addr)
|
||||||
(match-define (tcp-listener port) server-addr)
|
(match-define (tcp-listener port) server-addr)
|
||||||
(assert (tcp-port-allocation port server-addr))
|
(assert (tcp-port-allocation port server-addr))
|
||||||
|
@ -61,7 +78,7 @@
|
||||||
($ local-addr (tcp-address _ port))
|
($ local-addr (tcp-address _ port))
|
||||||
_)))
|
_)))
|
||||||
(spawn-relay server-addr remote-addr local-addr))))
|
(spawn-relay server-addr remote-addr local-addr))))
|
||||||
(actor #:name 'tcp-outbound-driver
|
(spawn #:name 'tcp-outbound-driver
|
||||||
(define local-ips (query-local-ip-addresses))
|
(define local-ips (query-local-ip-addresses))
|
||||||
(on (asserted (advertise (tcp-channel ($ local-addr (tcp-handle _))
|
(on (asserted (advertise (tcp-channel ($ local-addr (tcp-handle _))
|
||||||
($ remote-addr (tcp-address _ _))
|
($ remote-addr (tcp-address _ _))
|
||||||
|
@ -92,7 +109,7 @@
|
||||||
(define (spawn-relay local-user-addr remote-addr local-tcp-addr)
|
(define (spawn-relay local-user-addr remote-addr local-tcp-addr)
|
||||||
(define timer-name (list 'spawn-relay local-tcp-addr remote-addr))
|
(define timer-name (list 'spawn-relay local-tcp-addr remote-addr))
|
||||||
|
|
||||||
(actor #:name (list 'tcp-relay local-user-addr remote-addr local-tcp-addr)
|
(spawn #:name (list 'tcp-relay local-user-addr remote-addr local-tcp-addr)
|
||||||
(assert (tcp-port-allocation (tcp-address-port local-tcp-addr) local-user-addr))
|
(assert (tcp-port-allocation (tcp-address-port local-tcp-addr) local-user-addr))
|
||||||
(assert (advertise (tcp-channel remote-addr local-user-addr _)))
|
(assert (advertise (tcp-channel remote-addr local-user-addr _)))
|
||||||
(assert (advertise (tcp-channel local-tcp-addr remote-addr _)))
|
(assert (advertise (tcp-channel local-tcp-addr remote-addr _)))
|
||||||
|
@ -100,8 +117,7 @@
|
||||||
(field [local-peer-present? #f]
|
(field [local-peer-present? #f]
|
||||||
[remote-peer-present? #f])
|
[remote-peer-present? #f])
|
||||||
|
|
||||||
(on-start (send! (set-timer timer-name relay-peer-wait-time-msec 'relative)))
|
(on-timeout relay-peer-wait-time-msec
|
||||||
(on (message (timer-expired timer-name _))
|
|
||||||
(when (not (and (local-peer-present?) (remote-peer-present?)))
|
(when (not (and (local-peer-present?) (remote-peer-present?)))
|
||||||
(error 'spawn-relay "TCP relay process timed out waiting for peer")))
|
(error 'spawn-relay "TCP relay process timed out waiting for peer")))
|
||||||
|
|
||||||
|
@ -125,7 +141,7 @@
|
||||||
(define PROTOCOL-TCP 6)
|
(define PROTOCOL-TCP 6)
|
||||||
|
|
||||||
(define (spawn-kernel-tcp-driver)
|
(define (spawn-kernel-tcp-driver)
|
||||||
(actor #:name 'kernel-tcp-driver
|
(spawn #:name 'kernel-tcp-driver
|
||||||
(define local-ips (query-local-ip-addresses))
|
(define local-ips (query-local-ip-addresses))
|
||||||
|
|
||||||
(define active-state-vectors
|
(define active-state-vectors
|
||||||
|
@ -165,16 +181,6 @@
|
||||||
(define-syntax-rule (set-flags! v ...)
|
(define-syntax-rule (set-flags! v ...)
|
||||||
(begin (unless (zero? v) (set! flags (set-add flags 'v))) ...))
|
(begin (unless (zero? v) (set! flags (set-add flags 'v))) ...))
|
||||||
(set-flags! ns cwr ece urg ack psh rst syn fin)
|
(set-flags! ns cwr ece urg ack psh rst syn fin)
|
||||||
(log-info "TCP ~a:~a -> ~a:~a (seq ~a, ack ~a, flags ~a, window ~a)"
|
|
||||||
(ip-address->hostname src-ip)
|
|
||||||
src-port
|
|
||||||
(ip-address->hostname dst-ip)
|
|
||||||
dst-port
|
|
||||||
sequence-number
|
|
||||||
ack-number
|
|
||||||
flags
|
|
||||||
window-size)
|
|
||||||
(when spawn-needed? (log-info " - spawn needed!"))
|
|
||||||
(bit-string-case rest
|
(bit-string-case rest
|
||||||
([ (opts :: binary bytes (- (* data-offset 4) 20))
|
([ (opts :: binary bytes (- (* data-offset 4) 20))
|
||||||
(data :: binary) ]
|
(data :: binary) ]
|
||||||
|
@ -189,16 +195,17 @@
|
||||||
window-size
|
window-size
|
||||||
(bit-string->bytes opts)
|
(bit-string->bytes opts)
|
||||||
(bit-string->bytes data))))
|
(bit-string->bytes data))))
|
||||||
|
(log-netstack/tcp-debug "TCP ~a" (summarize-tcp-packet packet))
|
||||||
(when spawn-needed?
|
(when spawn-needed?
|
||||||
|
(log-netstack/tcp-debug " - spawn needed!")
|
||||||
(active-state-vectors (set-add (active-state-vectors) statevec))
|
(active-state-vectors (set-add (active-state-vectors) statevec))
|
||||||
(spawn-state-vector src-ip src-port dst-ip dst-port))
|
(spawn-state-vector src-ip src-port dst-ip dst-port))
|
||||||
;; TODO: get packet to the new state-vector process somehow
|
|
||||||
(send! packet)))
|
(send! packet)))
|
||||||
(else #f))))
|
(else #f))))
|
||||||
(else #f)))
|
(else #f)))
|
||||||
|
|
||||||
(begin/dataflow
|
(begin/dataflow
|
||||||
(log-info "SCN yielded statevecs ~v and local-ips ~v"
|
(log-netstack/tcp-debug "SCN yielded statevecs ~v and local-ips ~v"
|
||||||
(active-state-vectors)
|
(active-state-vectors)
|
||||||
(local-ips)))
|
(local-ips)))
|
||||||
|
|
||||||
|
@ -215,15 +222,7 @@
|
||||||
options
|
options
|
||||||
data)
|
data)
|
||||||
p)
|
p)
|
||||||
(log-info "TCP ~a:~a -> ~a:~a (seq ~a, ack ~a, flags ~a, window ~a)"
|
(log-netstack/tcp-debug "TCP ~a" (summarize-tcp-packet p))
|
||||||
(ip-address->hostname src-ip)
|
|
||||||
src-port
|
|
||||||
(ip-address->hostname dst-ip)
|
|
||||||
dst-port
|
|
||||||
sequence-number
|
|
||||||
ack-number
|
|
||||||
flags
|
|
||||||
window-size)
|
|
||||||
(define (flag-bit sym) (if (set-member? flags sym) 1 0))
|
(define (flag-bit sym) (if (set-member? flags sym) 1 0))
|
||||||
(define payload (bit-string (src-port :: integer bytes 2)
|
(define payload (bit-string (src-port :: integer bytes 2)
|
||||||
(dst-port :: integer bytes 2)
|
(dst-port :: integer bytes 2)
|
||||||
|
@ -264,16 +263,111 @@
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; Per-connection state vector process
|
;; Per-connection state vector process
|
||||||
|
|
||||||
|
;;---------------------------------------------------------------------------
|
||||||
|
;; From the RFC:
|
||||||
|
;;
|
||||||
|
;; Send Sequence Variables
|
||||||
|
;;
|
||||||
|
;; SND.UNA - send unacknowledged
|
||||||
|
;; SND.NXT - send next
|
||||||
|
;; SND.WND - send window
|
||||||
|
;; SND.UP - send urgent pointer
|
||||||
|
;; SND.WL1 - segment sequence number used for last window update
|
||||||
|
;; SND.WL2 - segment acknowledgment number used for last window
|
||||||
|
;; update
|
||||||
|
;; ISS - initial send sequence number
|
||||||
|
;;
|
||||||
|
;; Receive Sequence Variables
|
||||||
|
;;
|
||||||
|
;; RCV.NXT - receive next
|
||||||
|
;; RCV.WND - receive window
|
||||||
|
;; RCV.UP - receive urgent pointer
|
||||||
|
;; IRS - initial receive sequence number
|
||||||
|
;;
|
||||||
|
;; The following diagrams may help to relate some of these variables to
|
||||||
|
;; the sequence space.
|
||||||
|
;;
|
||||||
|
;; Send Sequence Space
|
||||||
|
;;
|
||||||
|
;; 1 2 3 4
|
||||||
|
;; ----------|----------|----------|----------
|
||||||
|
;; SND.UNA SND.NXT SND.UNA
|
||||||
|
;; +SND.WND
|
||||||
|
;;
|
||||||
|
;; 1 - old sequence numbers which have been acknowledged
|
||||||
|
;; 2 - sequence numbers of unacknowledged data
|
||||||
|
;; 3 - sequence numbers allowed for new data transmission
|
||||||
|
;; 4 - future sequence numbers which are not yet allowed
|
||||||
|
;;
|
||||||
|
;; Send Sequence Space
|
||||||
|
;;
|
||||||
|
;; Figure 4.
|
||||||
|
;;
|
||||||
|
;; The send window is the portion of the sequence space labeled 3 in
|
||||||
|
;; figure 4.
|
||||||
|
;;
|
||||||
|
;; Receive Sequence Space
|
||||||
|
;;
|
||||||
|
;; 1 2 3
|
||||||
|
;; ----------|----------|----------
|
||||||
|
;; RCV.NXT RCV.NXT
|
||||||
|
;; +RCV.WND
|
||||||
|
;;
|
||||||
|
;; 1 - old sequence numbers which have been acknowledged
|
||||||
|
;; 2 - sequence numbers allowed for new reception
|
||||||
|
;; 3 - future sequence numbers which are not yet allowed
|
||||||
|
;;
|
||||||
|
;; Receive Sequence Space
|
||||||
|
;;
|
||||||
|
;; Figure 5.
|
||||||
|
;;
|
||||||
|
;; The receive window is the portion of the sequence space labeled 2 in
|
||||||
|
;; figure 5.
|
||||||
|
;;
|
||||||
|
;; There are also some variables used frequently in the discussion that
|
||||||
|
;; take their values from the fields of the current segment.
|
||||||
|
;;
|
||||||
|
;; Current Segment Variables
|
||||||
|
;;
|
||||||
|
;; SEG.SEQ - segment sequence number
|
||||||
|
;; SEG.ACK - segment acknowledgment number
|
||||||
|
;; SEG.LEN - segment length
|
||||||
|
;; SEG.WND - segment window
|
||||||
|
;; SEG.UP - segment urgent pointer
|
||||||
|
;; SEG.PRC - segment precedence value
|
||||||
|
;;
|
||||||
|
;;---------------------------------------------------------------------------
|
||||||
|
|
||||||
(struct buffer (data ;; bit-string
|
(struct buffer (data ;; bit-string
|
||||||
seqn ;; names leftmost byte in data
|
seqn ;; names leftmost byte in data
|
||||||
window ;; counts bytes from leftmost byte in data
|
window ;; counts bytes from leftmost byte in data
|
||||||
finished?) ;; boolean: true after FIN
|
finished?) ;; boolean: true after FIN
|
||||||
#:transparent)
|
#:transparent)
|
||||||
|
|
||||||
|
;; Regarding acks:
|
||||||
|
;;
|
||||||
|
;; - we send an ack number that is (buffer-seqn (inbound)) plus the
|
||||||
|
;; number of buffered bytes.
|
||||||
|
;;
|
||||||
|
;; - acks received allow us to advance (buffer-seqn (outbound)) (that
|
||||||
|
;; is, SND.UNA) to that point, discarding buffered data to do so.
|
||||||
|
|
||||||
|
;; Regarding windows:
|
||||||
|
;;
|
||||||
|
;; - (buffer-window (outbound)) is the size of the peer's receive
|
||||||
|
;; window. Do not allow more than this many bytes to be
|
||||||
|
;; unacknowledged on the wire.
|
||||||
|
;;
|
||||||
|
;; - (buffer-window (inbound)) is the size of our receive window. The
|
||||||
|
;; peer should not exceed this; we should ignore data received that
|
||||||
|
;; extends beyond this. Once we implement flow control locally
|
||||||
|
;; (ahem) we should move this around, but at present it is fixed.
|
||||||
|
|
||||||
|
;; TODO: Zero receive window probe when we have something to say.
|
||||||
|
|
||||||
(define (buffer-push b data)
|
(define (buffer-push b data)
|
||||||
(struct-copy buffer b [data (bit-string-append (buffer-data b) data)]))
|
(struct-copy buffer b [data (bit-string-append (buffer-data b) data)]))
|
||||||
|
|
||||||
(define transmit-check-interval-msec 2000)
|
|
||||||
(define inbound-buffer-limit 65535)
|
(define inbound-buffer-limit 65535)
|
||||||
(define maximum-segment-size 536) ;; bytes
|
(define maximum-segment-size 536) ;; bytes
|
||||||
(define maximum-segment-lifetime-sec (* 2 60)) ;; two minutes; 2MSL is TIME-WAIT timeout
|
(define maximum-segment-lifetime-sec (* 2 60)) ;; two minutes; 2MSL is TIME-WAIT timeout
|
||||||
|
@ -290,39 +384,97 @@
|
||||||
(- larger smaller)))
|
(- larger smaller)))
|
||||||
|
|
||||||
(define (seq> a b)
|
(define (seq> a b)
|
||||||
|
(not (seq>= b a)))
|
||||||
|
|
||||||
|
(define (seq>= a b)
|
||||||
(< (seq- a b) #x80000000))
|
(< (seq- a b) #x80000000))
|
||||||
|
|
||||||
|
(define (seq-min a b) (if (seq> a b) b a))
|
||||||
|
(define (seq-max a b) (if (seq> a b) a b))
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(check-equal? (seq+ 41724780 1) 41724781)
|
||||||
|
(check-equal? (seq+ 0 1) 1)
|
||||||
|
(check-equal? (seq+ #x80000000 1) #x80000001)
|
||||||
|
(check-equal? (seq+ #xffffffff 1) #x00000000)
|
||||||
|
|
||||||
|
(check-equal? (seq> 41724780 41724780) #f)
|
||||||
|
(check-equal? (seq> 41724781 41724780) #t)
|
||||||
|
(check-equal? (seq> 41724780 41724781) #f)
|
||||||
|
|
||||||
|
(check-equal? (seq> 0 0) #f)
|
||||||
|
(check-equal? (seq> 1 0) #t)
|
||||||
|
(check-equal? (seq> 0 1) #f)
|
||||||
|
|
||||||
|
(check-equal? (seq> #x80000000 #x80000000) #f)
|
||||||
|
(check-equal? (seq> #x80000001 #x80000000) #t)
|
||||||
|
(check-equal? (seq> #x80000000 #x80000001) #f)
|
||||||
|
|
||||||
|
(check-equal? (seq> #xffffffff #xffffffff) #f)
|
||||||
|
(check-equal? (seq> #x00000000 #xffffffff) #t)
|
||||||
|
(check-equal? (seq> #xffffffff #x00000000) #f)
|
||||||
|
|
||||||
|
(check-equal? (seq>= 41724780 41724780) #t)
|
||||||
|
(check-equal? (seq>= 41724781 41724780) #t)
|
||||||
|
(check-equal? (seq>= 41724780 41724781) #f)
|
||||||
|
|
||||||
|
(check-equal? (seq>= 0 0) #t)
|
||||||
|
(check-equal? (seq>= 1 0) #t)
|
||||||
|
(check-equal? (seq>= 0 1) #f)
|
||||||
|
|
||||||
|
(check-equal? (seq>= #x80000000 #x80000000) #t)
|
||||||
|
(check-equal? (seq>= #x80000001 #x80000000) #t)
|
||||||
|
(check-equal? (seq>= #x80000000 #x80000001) #f)
|
||||||
|
|
||||||
|
(check-equal? (seq>= #xffffffff #xffffffff) #t)
|
||||||
|
(check-equal? (seq>= #x00000000 #xffffffff) #t)
|
||||||
|
(check-equal? (seq>= #xffffffff #x00000000) #f))
|
||||||
|
|
||||||
(define (spawn-state-vector src-ip src-port dst-ip dst-port)
|
(define (spawn-state-vector src-ip src-port dst-ip dst-port)
|
||||||
(define src (tcp-address (ip-address->hostname src-ip) src-port))
|
(define src (tcp-address (ip-address->hostname src-ip) src-port))
|
||||||
(define dst (tcp-address (ip-address->hostname dst-ip) dst-port))
|
(define dst (tcp-address (ip-address->hostname dst-ip) dst-port))
|
||||||
(define (timer-name kind) (list 'tcp-timer kind src dst))
|
|
||||||
|
|
||||||
(actor
|
(spawn
|
||||||
#:name (list 'tcp-state-vector
|
#:name (list 'tcp-state-vector
|
||||||
(ip-address->hostname src-ip)
|
(ip-address->hostname src-ip)
|
||||||
src-port
|
src-port
|
||||||
(ip-address->hostname dst-ip)
|
(ip-address->hostname dst-ip)
|
||||||
dst-port)
|
dst-port)
|
||||||
|
;; Spawn with initial assertions so we are guaranteed to be sent
|
||||||
|
;; the packet that led to our creation (in the case of an accepted
|
||||||
|
;; server connection), and so that we at the same moment gain
|
||||||
|
;; knowledge of whether we were created on a listening port:
|
||||||
|
#:assertions* (patch-added
|
||||||
|
(patch-seq (sub (tcp-packet #t src-ip src-port dst-ip dst-port ? ? ? ? ? ?))
|
||||||
|
(sub (observe (advertise (tcp-channel ? (tcp-listener dst-port) ?))))))
|
||||||
|
|
||||||
|
(define root-facet (current-facet-id))
|
||||||
|
|
||||||
(define initial-outbound-seqn
|
(define initial-outbound-seqn
|
||||||
;; Yuck
|
;; Yuck
|
||||||
(inexact->exact (truncate (* #x100000000 (random)))))
|
(inexact->exact (truncate (* #x100000000 (random)))))
|
||||||
|
|
||||||
(field [outbound (buffer #"!" initial-outbound-seqn 0 #f)] ;; dummy data at SYN position
|
(field [outbound (buffer #"!" initial-outbound-seqn 0 #f)] ;; dummy data at SYN position
|
||||||
|
[send-next initial-outbound-seqn] ;; SND.NXT
|
||||||
|
[high-water-mark initial-outbound-seqn]
|
||||||
|
|
||||||
[inbound (buffer #"" #f inbound-buffer-limit #f)]
|
[inbound (buffer #"" #f inbound-buffer-limit #f)]
|
||||||
|
[transmission-needed? #f]
|
||||||
[syn-acked? #f]
|
[syn-acked? #f]
|
||||||
|
|
||||||
[latest-peer-activity-time (current-inexact-milliseconds)]
|
[latest-peer-activity-time (current-inexact-milliseconds)]
|
||||||
;; ^ the most recent time we heard from our peer
|
;; ^ the most recent time we heard from our peer
|
||||||
[user-timeout-base-time (current-inexact-milliseconds)]
|
[user-timeout-base-time (current-inexact-milliseconds)]
|
||||||
;; ^ when the index of the first outbound unacknowledged byte changed
|
;; ^ when the index of the first outbound unacknowledged byte changed
|
||||||
[most-recent-time (current-inexact-milliseconds)]
|
|
||||||
;; ^ updated by timer expiry; a field, to trigger quit checks
|
|
||||||
[quit-because-reset? #f])
|
|
||||||
|
|
||||||
(let ()
|
;; RFC 6298
|
||||||
(local-require (submod syndicate/actor priorities))
|
[rtt-estimate #f] ;; milliseconds; "SRTT"
|
||||||
(on-event #:priority *query-priority*
|
[rtt-mean-deviation #f] ;; milliseconds; "RTTVAR"
|
||||||
[_ (most-recent-time (current-inexact-milliseconds))]))
|
[retransmission-timeout 1000] ;; milliseconds
|
||||||
|
[retransmission-deadline #f]
|
||||||
|
[rtt-estimate-seqn-target #f]
|
||||||
|
[rtt-estimate-start-time #f]
|
||||||
|
)
|
||||||
|
|
||||||
(define (next-expected-seqn)
|
(define (next-expected-seqn)
|
||||||
(define b (inbound))
|
(define b (inbound))
|
||||||
|
@ -333,7 +485,6 @@
|
||||||
(inbound (struct-copy buffer (inbound) [seqn seqn])))
|
(inbound (struct-copy buffer (inbound) [seqn seqn])))
|
||||||
|
|
||||||
(define (incorporate-segment! data)
|
(define (incorporate-segment! data)
|
||||||
;; (log-info "GOT INBOUND STUFF TO DELIVER ~v" data)
|
|
||||||
(when (not (buffer-finished? (inbound)))
|
(when (not (buffer-finished? (inbound)))
|
||||||
(inbound (buffer-push (inbound) data))))
|
(inbound (buffer-push (inbound) data))))
|
||||||
|
|
||||||
|
@ -349,158 +500,263 @@
|
||||||
;; (Setof Symbol) -> Void
|
;; (Setof Symbol) -> Void
|
||||||
(define (check-fin! flags)
|
(define (check-fin! flags)
|
||||||
(define b (inbound))
|
(define b (inbound))
|
||||||
|
(when (not (buffer-finished? b))
|
||||||
(unless (bit-string-empty? (buffer-data b)) ;; assured by deliver-inbound-locally
|
(unless (bit-string-empty? (buffer-data b)) ;; assured by deliver-inbound-locally
|
||||||
(error 'check-fin "Nonempty inbound buffer"))
|
(error 'check-fin "Nonempty inbound buffer"))
|
||||||
(when (set-member? flags 'fin)
|
(when (set-member? flags 'fin)
|
||||||
(log-info "Closing inbound stream.")
|
(log-netstack/tcp-debug "Closing inbound stream.")
|
||||||
(inbound (struct-copy buffer b
|
(inbound (struct-copy buffer b
|
||||||
[seqn (seq+ (buffer-seqn b) 1)] ;; reliable: count fin as a byte
|
[seqn (seq+ (buffer-seqn b) 1)] ;; reliable: count fin as a byte
|
||||||
[finished? #t]))))
|
[finished? #t]))
|
||||||
|
(transmission-needed? #t)))) ;; we must send an ack
|
||||||
|
|
||||||
|
;; -> Void
|
||||||
|
(define (arm-retransmission-timer!)
|
||||||
|
(log-netstack/tcp-debug "Arming retransmission timer (~a ms)" (retransmission-timeout))
|
||||||
|
(retransmission-deadline (+ (current-inexact-milliseconds) (retransmission-timeout))))
|
||||||
|
|
||||||
|
;; Timestamp -> Void
|
||||||
|
(define (start-rtt-estimate! now)
|
||||||
|
(define target (send-next))
|
||||||
|
(when (seq>= target (high-water-mark))
|
||||||
|
(log-netstack/tcp-debug "Starting RTT estimation; target seqn is ~a" target)
|
||||||
|
(rtt-estimate-start-time now)
|
||||||
|
(rtt-estimate-seqn-target target)))
|
||||||
|
|
||||||
|
;; -> Void
|
||||||
|
(define (reset-rtt-estimate!)
|
||||||
|
(rtt-estimate-start-time #f)
|
||||||
|
(rtt-estimate-seqn-target #f))
|
||||||
|
|
||||||
|
;; Timestamp -> Void
|
||||||
|
(define (finish-rtt-estimate! now)
|
||||||
|
(define rtt-measurement (- now (rtt-estimate-start-time)))
|
||||||
|
(reset-rtt-estimate!)
|
||||||
|
(log-netstack/tcp-debug "RTT measurement: ~a ms" rtt-measurement)
|
||||||
|
;; RFC 6298 Section 2.
|
||||||
|
(cond [(rtt-estimate) => ;; we have a previous estimate, RFC 6298 rule (2.3)
|
||||||
|
(lambda (prev-estimate)
|
||||||
|
(rtt-mean-deviation (+ (* 0.75 (rtt-mean-deviation))
|
||||||
|
(* 0.25 (abs (- rtt-measurement prev-estimate)))))
|
||||||
|
(rtt-estimate (+ (* 0.875 prev-estimate)
|
||||||
|
(* 0.125 rtt-measurement))))]
|
||||||
|
[else ;; no previous estimate, RFC 6298 rule (2.2) applies
|
||||||
|
(rtt-estimate rtt-measurement)
|
||||||
|
(rtt-mean-deviation (/ rtt-measurement 2))])
|
||||||
|
(default-retransmission-timeout!)
|
||||||
|
(log-netstack/tcp-debug "RTT measurement ~a ms; estimate ~a ms; mean deviation ~a ms; RTO ~a ms"
|
||||||
|
rtt-measurement
|
||||||
|
(rtt-estimate)
|
||||||
|
(rtt-mean-deviation)
|
||||||
|
(retransmission-timeout)))
|
||||||
|
|
||||||
|
(define (default-retransmission-timeout!)
|
||||||
|
(retransmission-timeout
|
||||||
|
(max 200 ;; RFC 6298 rule (2.4), but cribbing from Linux's 200ms minimum
|
||||||
|
(min 60000 ;; (2.5)
|
||||||
|
(+ (rtt-estimate) (* 4 (rtt-mean-deviation))))))) ;; (2.2), (2.3)
|
||||||
|
|
||||||
;; Boolean SeqNum -> Void
|
;; Boolean SeqNum -> Void
|
||||||
(define (discard-acknowledged-outbound! ack? ackn)
|
(define (discard-acknowledged-outbound! ack? ackn)
|
||||||
(when ack?
|
(when ack?
|
||||||
(let* ((b (outbound))
|
(let* ((b (outbound))
|
||||||
(base (buffer-seqn b))
|
(base (buffer-seqn b))
|
||||||
(limit (seq+ (buffer-seqn b) (bit-string-byte-count (buffer-data b))))
|
(ackn (seq-min ackn (high-water-mark)))
|
||||||
(ackn (if (seq> ackn limit) limit ackn))
|
(ackn (seq-max ackn base))
|
||||||
(ackn (if (seq> base ackn) base ackn))
|
|
||||||
(dist (seq- ackn base)))
|
(dist (seq- ackn base)))
|
||||||
(define remaining-data (bit-string-drop (buffer-data b) (* dist 8))) ;; bit offset!
|
|
||||||
(user-timeout-base-time (current-inexact-milliseconds))
|
(user-timeout-base-time (current-inexact-milliseconds))
|
||||||
|
(when (positive? dist)
|
||||||
|
(when (not (syn-acked?)) (syn-acked? #t))
|
||||||
|
(log-netstack/tcp-debug "******** ackn ~a; send-next ~a; high-water-mark ~a"
|
||||||
|
ackn
|
||||||
|
(send-next)
|
||||||
|
(high-water-mark))
|
||||||
|
(when (seq> ackn (send-next)) (send-next ackn))
|
||||||
|
(when (and (rtt-estimate-seqn-target) (seq>= ackn (rtt-estimate-seqn-target)))
|
||||||
|
(finish-rtt-estimate! (current-inexact-milliseconds)))
|
||||||
|
|
||||||
|
(define remaining-data (bit-string-drop (buffer-data b) (* dist 8))) ;; bit offset!
|
||||||
(outbound (struct-copy buffer b [data remaining-data] [seqn ackn]))
|
(outbound (struct-copy buffer b [data remaining-data] [seqn ackn]))
|
||||||
(syn-acked? (or (syn-acked?) (positive? dist))))))
|
|
||||||
|
(default-retransmission-timeout!)
|
||||||
|
(log-netstack/tcp-debug "Positive distance moved by ack, RTO now ~a"
|
||||||
|
(retransmission-timeout))
|
||||||
|
(arm-retransmission-timer!)))))
|
||||||
|
|
||||||
;; Nat -> Void
|
;; Nat -> Void
|
||||||
(define (update-outbound-window! peer-window)
|
(define (update-outbound-window! peer-window)
|
||||||
|
(log-netstack/tcp-debug "Peer's receive-window is now ~a" peer-window)
|
||||||
(outbound (struct-copy buffer (outbound) [window peer-window])))
|
(outbound (struct-copy buffer (outbound) [window peer-window])))
|
||||||
|
|
||||||
|
;; True iff there is no queued-up data waiting either for
|
||||||
|
;; transmission or (if transmitted already) for acknowledgement.
|
||||||
(define (all-output-acknowledged?)
|
(define (all-output-acknowledged?)
|
||||||
(bit-string-empty? (buffer-data (outbound))))
|
(bit-string-empty? (buffer-data (outbound))))
|
||||||
|
|
||||||
;; (Option SeqNum) -> Void
|
|
||||||
(define (send-outbound! old-ackn)
|
|
||||||
(define b (outbound))
|
|
||||||
(define pending-byte-count (max 0 (- (bit-string-byte-count (buffer-data b))
|
|
||||||
(if (buffer-finished? b) 1 0))))
|
|
||||||
|
|
||||||
(define segment-size (min maximum-segment-size
|
|
||||||
(if (syn-acked?) (buffer-window b) 1)
|
|
||||||
;; ^ can only send SYN until SYN is acked
|
|
||||||
pending-byte-count))
|
|
||||||
(define segment-offset (if (syn-acked?) 0 1))
|
|
||||||
(define chunk0 (bit-string-take (buffer-data b) (* segment-size 8))) ;; bit offset!
|
|
||||||
(define chunk (bit-string-drop chunk0 (* segment-offset 8))) ;; bit offset!
|
|
||||||
(define ackn (next-expected-seqn))
|
|
||||||
(define flags (set))
|
|
||||||
(when ackn
|
|
||||||
(set! flags (set-add flags 'ack)))
|
|
||||||
(when (not (syn-acked?))
|
|
||||||
(set! flags (set-add flags 'syn)))
|
|
||||||
(when (and (buffer-finished? b)
|
|
||||||
(syn-acked?)
|
|
||||||
(= segment-size pending-byte-count)
|
|
||||||
(not (all-output-acknowledged?))) ;; TODO: reexamine. This looks fishy
|
|
||||||
(set! flags (set-add flags 'fin)))
|
|
||||||
(define window (min 65535 ;; limit of field width
|
|
||||||
(max 0 ;; can't be negative
|
|
||||||
(- (buffer-window (inbound))
|
|
||||||
(bit-string-byte-count (buffer-data (inbound)))))))
|
|
||||||
(unless (and (equal? ackn old-ackn)
|
|
||||||
(syn-acked?)
|
|
||||||
(not (set-member? flags 'fin))
|
|
||||||
(zero? (bit-string-byte-count chunk)))
|
|
||||||
(local-require racket/pretty)
|
|
||||||
(pretty-write `(send-outbound (old-ackn ,old-ackn)
|
|
||||||
(flags ,flags)))
|
|
||||||
(flush-output)
|
|
||||||
(send! (tcp-packet #f dst-ip dst-port src-ip src-port
|
|
||||||
(buffer-seqn b)
|
|
||||||
(or ackn 0)
|
|
||||||
flags
|
|
||||||
window
|
|
||||||
#""
|
|
||||||
chunk))))
|
|
||||||
|
|
||||||
(define (bump-peer-activity-time!)
|
|
||||||
(latest-peer-activity-time (current-inexact-milliseconds)))
|
|
||||||
|
|
||||||
;; Number -> Boolean
|
|
||||||
(define (heard-from-peer-within-msec? msec)
|
|
||||||
(<= (- (most-recent-time) (latest-peer-activity-time)) msec))
|
|
||||||
|
|
||||||
(define (user-timeout-expired?)
|
|
||||||
(and (not (all-output-acknowledged?))
|
|
||||||
(> (- (most-recent-time) (user-timeout-base-time))
|
|
||||||
user-timeout-msec)))
|
|
||||||
|
|
||||||
(define (send-set-transmit-check-timer!)
|
|
||||||
(send! (set-timer (timer-name 'transmit-check)
|
|
||||||
transmit-check-interval-msec
|
|
||||||
'relative)))
|
|
||||||
|
|
||||||
(define (reset! seqn ackn)
|
|
||||||
(log-warning "Sending RST from ~a:~a to ~a:~a"
|
|
||||||
(ip-address->hostname dst-ip)
|
|
||||||
dst-port
|
|
||||||
(ip-address->hostname src-ip)
|
|
||||||
src-port)
|
|
||||||
(quit-because-reset? #t)
|
|
||||||
(send! (tcp-packet #f dst-ip dst-port src-ip src-port
|
|
||||||
seqn
|
|
||||||
ackn
|
|
||||||
(set 'ack 'rst)
|
|
||||||
0
|
|
||||||
#""
|
|
||||||
#"")))
|
|
||||||
|
|
||||||
(define (close-outbound-stream!)
|
(define (close-outbound-stream!)
|
||||||
(define b (outbound))
|
(define b (outbound))
|
||||||
(when (not (buffer-finished? b))
|
(when (not (buffer-finished? b))
|
||||||
(outbound (struct-copy buffer (buffer-push b #"!") ;; dummy FIN byte
|
(outbound (struct-copy buffer (buffer-push b #"!") ;; dummy FIN byte
|
||||||
[finished? #t]))))
|
[finished? #t]))
|
||||||
|
(transmission-needed? #t))) ;; the FIN machinery is awkwardly
|
||||||
|
;; different from the usual
|
||||||
|
;; advance-based decision on
|
||||||
|
;; whether to send a packet or not
|
||||||
|
|
||||||
|
;; SeqNum Boolean Boolean Bytes -> TcpPacket
|
||||||
|
(define (build-outbound-packet seqn mention-syn? mention-fin? payload)
|
||||||
|
(define ackn (next-expected-seqn))
|
||||||
|
(define window (min 65535 ;; limit of field width
|
||||||
|
(max 0 ;; can't be negative
|
||||||
|
(- (buffer-window (inbound))
|
||||||
|
(bit-string-byte-count (buffer-data (inbound)))))))
|
||||||
|
|
||||||
|
(define flags (set))
|
||||||
|
(when ackn (set! flags (set-add flags 'ack)))
|
||||||
|
(when mention-syn? (set! flags (set-add flags 'syn)))
|
||||||
|
(when mention-fin? (set! flags (set-add flags 'fin)))
|
||||||
|
|
||||||
|
(tcp-packet #f dst-ip dst-port src-ip src-port
|
||||||
|
seqn
|
||||||
|
(or ackn 0)
|
||||||
|
flags
|
||||||
|
window
|
||||||
|
#""
|
||||||
|
payload))
|
||||||
|
|
||||||
|
(define (outbound-data-chunk offset length)
|
||||||
|
(bit-string-take (bit-string-drop (buffer-data (outbound)) (* offset 8)) (* length 8)))
|
||||||
|
|
||||||
|
;; Transmit acknowledgements and outbound data.
|
||||||
|
(begin/dataflow
|
||||||
|
(define in-flight-count (seq- (send-next) (buffer-seqn (outbound))))
|
||||||
|
|
||||||
|
(define-values (mention-syn? ;; whether to mention SYN
|
||||||
|
payload-size ;; how many bytes of payload data to include
|
||||||
|
mention-fin? ;; whether to mention FIN
|
||||||
|
advance) ;; how far to advance send-next
|
||||||
|
(if (syn-acked?)
|
||||||
|
(let* ((effective-window (max 0 (- (buffer-window (outbound)) in-flight-count)))
|
||||||
|
(stream-ended? (buffer-finished? (outbound)))
|
||||||
|
(max-advance (- (bit-string-byte-count (buffer-data (outbound))) in-flight-count))
|
||||||
|
(payload-size (min maximum-segment-size effective-window max-advance)))
|
||||||
|
(if (and stream-ended? ;; there's a FIN enqueued,
|
||||||
|
(positive? payload-size) ;; we aren't sending nothing at all,
|
||||||
|
(= payload-size max-advance)) ;; and our payload would cover the FIN
|
||||||
|
(values #f (- payload-size 1) #t payload-size)
|
||||||
|
(values #f payload-size #f payload-size)))
|
||||||
|
(cond [(= in-flight-count 0) (values #t 0 #f 1)]
|
||||||
|
[(= in-flight-count 1) (values #t 0 #f 0)]
|
||||||
|
[else (error 'send-outbound!
|
||||||
|
"Invalid state: send-next had advanced too far before SYN")])))
|
||||||
|
|
||||||
|
(when (and (or (next-expected-seqn) (local-peer-seen?))
|
||||||
|
;; ^ Talk only either if: we know the peer's seqn, or
|
||||||
|
;; we don't, but a local peer exists, which means
|
||||||
|
;; we're an outbound connection rather than a
|
||||||
|
;; listener.
|
||||||
|
(or (transmission-needed?)
|
||||||
|
(positive? advance))
|
||||||
|
;; ^ ... and we have something to say. Something to
|
||||||
|
;; ack, or something to send.
|
||||||
|
)
|
||||||
|
(define packet-seqn (if mention-syn? (buffer-seqn (outbound)) (send-next)))
|
||||||
|
(define packet (build-outbound-packet packet-seqn
|
||||||
|
mention-syn?
|
||||||
|
mention-fin?
|
||||||
|
(outbound-data-chunk in-flight-count payload-size)))
|
||||||
|
(when (positive? advance)
|
||||||
|
(define new-send-next (seq+ (send-next) advance))
|
||||||
|
(send-next new-send-next)
|
||||||
|
(when (seq> new-send-next (high-water-mark))
|
||||||
|
(high-water-mark new-send-next)))
|
||||||
|
(when (transmission-needed?)
|
||||||
|
(transmission-needed? #f))
|
||||||
|
|
||||||
|
;; (log-netstack/tcp-debug " sending ~v" packet)
|
||||||
|
(send! packet)
|
||||||
|
;; (if (> (random) 0.5)
|
||||||
|
;; (begin (log-netstack/tcp-debug "Send ~a" (summarize-tcp-packet packet))
|
||||||
|
;; (send! packet))
|
||||||
|
;; (log-netstack/tcp-debug "Drop ~a" (summarize-tcp-packet packet)))
|
||||||
|
|
||||||
|
(when (or mention-syn? mention-fin? (positive? advance))
|
||||||
|
(when (not (retransmission-deadline))
|
||||||
|
(arm-retransmission-timer!))
|
||||||
|
(when (not (rtt-estimate-start-time))
|
||||||
|
(start-rtt-estimate! (current-inexact-milliseconds))))))
|
||||||
|
|
||||||
|
(begin/dataflow
|
||||||
|
(when (and (retransmission-deadline) (all-output-acknowledged?))
|
||||||
|
(log-netstack/tcp-debug "All output acknowledged; disarming retransmission timer")
|
||||||
|
(retransmission-deadline #f)))
|
||||||
|
|
||||||
|
(on #:when (retransmission-deadline) (asserted (later-than (retransmission-deadline)))
|
||||||
|
(send-next (buffer-seqn (outbound)))
|
||||||
|
(log-netstack/tcp-debug "Retransmission deadline fired, RTO was ~a; reset to ~a"
|
||||||
|
(retransmission-timeout)
|
||||||
|
(send-next))
|
||||||
|
(update-outbound-window! maximum-segment-size) ;; temporary. Will reopen on next ack
|
||||||
|
(transmission-needed? #t)
|
||||||
|
(retransmission-deadline #f)
|
||||||
|
(reset-rtt-estimate!) ;; give up on current RTT estimation
|
||||||
|
(retransmission-timeout (min 64000 (* 2 (retransmission-timeout))))
|
||||||
|
(log-netstack/tcp-debug " RTO now ~a" (retransmission-timeout)))
|
||||||
|
|
||||||
|
(define (reset! seqn ackn)
|
||||||
|
(define reset-packet (tcp-packet #f dst-ip dst-port src-ip src-port
|
||||||
|
seqn
|
||||||
|
ackn
|
||||||
|
(set 'ack 'rst)
|
||||||
|
0
|
||||||
|
#""
|
||||||
|
#""))
|
||||||
|
(log-netstack/tcp-warning "Reset ~a" (summarize-tcp-packet reset-packet))
|
||||||
|
(stop-facet root-facet)
|
||||||
|
(send! reset-packet))
|
||||||
|
|
||||||
(assert #:when (and (syn-acked?) (not (buffer-finished? (inbound))))
|
(assert #:when (and (syn-acked?) (not (buffer-finished? (inbound))))
|
||||||
(advertise (tcp-channel src dst _)))
|
(advertise (tcp-channel src dst _)))
|
||||||
|
|
||||||
(stop-when
|
(on-start (log-netstack/tcp-info "Starting state vector ~a-~a" src-port dst-port))
|
||||||
(rising-edge
|
(on-stop (log-netstack/tcp-info "Stopping state vector ~a-~a" src-port dst-port))
|
||||||
(and (buffer-finished? (outbound))
|
|
||||||
|
(stop-when #:when (and (buffer-finished? (outbound))
|
||||||
(buffer-finished? (inbound))
|
(buffer-finished? (inbound))
|
||||||
(all-output-acknowledged?)
|
(all-output-acknowledged?))
|
||||||
(not (heard-from-peer-within-msec? (* 2 1000 maximum-segment-lifetime-sec)))))
|
(asserted (later-than (+ (latest-peer-activity-time)
|
||||||
|
(* 2 1000 maximum-segment-lifetime-sec))))
|
||||||
;; Everything is cleanly shut down, and we just need to wait a while for unexpected
|
;; Everything is cleanly shut down, and we just need to wait a while for unexpected
|
||||||
;; packets before we release the state vector.
|
;; packets before we release the state vector.
|
||||||
)
|
)
|
||||||
|
|
||||||
(stop-when
|
(stop-when #:when (not (all-output-acknowledged?))
|
||||||
(rising-edge (user-timeout-expired?))
|
(asserted (later-than (+ (user-timeout-base-time) user-timeout-msec)))
|
||||||
;; We've been plaintively retransmitting for user-timeout-msec without hearing anything
|
;; We've been plaintively retransmitting for user-timeout-msec without hearing anything
|
||||||
;; back; this is a crude approximation of the real condition for TCP_USER_TIMEOUT, but
|
;; back; this is a crude approximation of the real condition for TCP_USER_TIMEOUT, but
|
||||||
;; it will do for now? TODO
|
;; it will do for now? TODO
|
||||||
(log-info "TCP_USER_TIMEOUT fired."))
|
(log-netstack/tcp-warning "TCP_USER_TIMEOUT fired."))
|
||||||
|
|
||||||
(stop-when (rising-edge (quit-because-reset?)))
|
|
||||||
|
|
||||||
(define/query-value local-peer-seen? #f (observe (tcp-channel src dst _)) #t
|
(define/query-value local-peer-seen? #f (observe (tcp-channel src dst _)) #t
|
||||||
#:on-remove (begin
|
#:on-remove (begin
|
||||||
(log-info "Closing outbound stream.")
|
(log-netstack/tcp-debug "Closing outbound stream.")
|
||||||
(close-outbound-stream!)
|
(close-outbound-stream!)))
|
||||||
(send-outbound! (buffer-seqn (inbound)))))
|
|
||||||
|
|
||||||
(define/query-value listener-listening?
|
(define/query-value listener-listening?
|
||||||
#f
|
#f
|
||||||
(observe (advertise (tcp-channel _ (tcp-listener dst-port) _)))
|
(observe (advertise (tcp-channel _ (tcp-listener dst-port) _)))
|
||||||
#t)
|
#t)
|
||||||
|
|
||||||
|
(define (trigger-ack!)
|
||||||
|
(transmission-needed? #t))
|
||||||
|
|
||||||
(on (message (tcp-packet #t src-ip src-port dst-ip dst-port
|
(on (message (tcp-packet #t src-ip src-port dst-ip dst-port
|
||||||
$seqn $ackn $flags $window $options $data))
|
$seqn $ackn $flags $window $options $data))
|
||||||
(define old-ackn (buffer-seqn (inbound)))
|
|
||||||
(define expected (next-expected-seqn))
|
(define expected (next-expected-seqn))
|
||||||
(define is-syn? (set-member? flags 'syn))
|
(define is-syn? (set-member? flags 'syn))
|
||||||
(define is-fin? (set-member? flags 'fin))
|
(define is-fin? (set-member? flags 'fin))
|
||||||
(cond
|
(cond
|
||||||
[(set-member? flags 'rst) (quit-because-reset? #t)]
|
[(set-member? flags 'rst) (stop-facet root-facet)]
|
||||||
[(and (not expected) ;; no syn yet
|
[(and (not expected) ;; no syn yet
|
||||||
(or (not is-syn?) ;; and this isn't it
|
(or (not is-syn?) ;; and this isn't it
|
||||||
(and (not (listener-listening?)) ;; or it is, but no listener...
|
(and (not (listener-listening?)) ;; or it is, but no listener...
|
||||||
|
@ -513,38 +769,28 @@
|
||||||
(cond
|
(cond
|
||||||
[(not expected) ;; haven't seen syn yet, but we know this is it
|
[(not expected) ;; haven't seen syn yet, but we know this is it
|
||||||
(set-inbound-seqn! (seq+ seqn 1))
|
(set-inbound-seqn! (seq+ seqn 1))
|
||||||
(incorporate-segment! data)]
|
(incorporate-segment! data)
|
||||||
|
(trigger-ack!)]
|
||||||
[(= expected seqn)
|
[(= expected seqn)
|
||||||
(incorporate-segment! data)]
|
(incorporate-segment! data)
|
||||||
[else (void)])
|
(when (positive? (bit-string-byte-count data)) (trigger-ack!))]
|
||||||
|
[else
|
||||||
|
(trigger-ack!)])
|
||||||
(deliver-inbound-locally!)
|
(deliver-inbound-locally!)
|
||||||
(check-fin! flags)
|
(check-fin! flags)
|
||||||
(discard-acknowledged-outbound! (set-member? flags 'ack) ackn)
|
(discard-acknowledged-outbound! (set-member? flags 'ack) ackn)
|
||||||
(update-outbound-window! window)
|
(update-outbound-window! window)
|
||||||
(send-outbound! old-ackn)
|
(latest-peer-activity-time (current-inexact-milliseconds))]))
|
||||||
(bump-peer-activity-time!)]))
|
|
||||||
|
|
||||||
(on (message (tcp-channel dst src $bs))
|
(on (message (tcp-channel dst src $bs))
|
||||||
(define old-ackn (buffer-seqn (inbound)))
|
;; (log-netstack/tcp-debug "GOT MORE STUFF TO DELIVER ~v" bs)
|
||||||
;; (log-info "GOT MORE STUFF TO DELIVER ~v" bs)
|
|
||||||
|
|
||||||
(when (all-output-acknowledged?)
|
(when (all-output-acknowledged?)
|
||||||
;; Only move user-timeout-base-time if there wasn't
|
;; Only move user-timeout-base-time if there wasn't
|
||||||
;; already some outstanding output.
|
;; already some outstanding output.
|
||||||
(user-timeout-base-time (current-inexact-milliseconds)))
|
(user-timeout-base-time (current-inexact-milliseconds)))
|
||||||
|
|
||||||
(outbound (buffer-push (outbound) bs))
|
(outbound (buffer-push (outbound) bs)))))
|
||||||
(send-outbound! old-ackn))
|
|
||||||
|
|
||||||
(on-start (send-set-transmit-check-timer!))
|
|
||||||
(on (message (timer-expired (timer-name 'transmit-check) _))
|
|
||||||
(define old-ackn (buffer-seqn (inbound)))
|
|
||||||
;; TODO: I am abusing this timer for multiple tasks. Notably, this is a (crude) means of
|
|
||||||
;; retransmitting outbound data as well as a means of checking for an expired
|
|
||||||
;; TCP_USER_TIMEOUT. A better design would have separate timers and a more fine-grained
|
|
||||||
;; approach.
|
|
||||||
(send-set-transmit-check-timer!)
|
|
||||||
(send-outbound! old-ackn))))
|
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
#lang syndicate/actor
|
#lang syndicate
|
||||||
|
|
||||||
(provide (struct-out udp-remote-address)
|
(provide (struct-out udp-remote-address)
|
||||||
(struct-out udp-handle)
|
(struct-out udp-handle)
|
||||||
|
@ -50,18 +50,18 @@
|
||||||
(define (spawn-udp-driver)
|
(define (spawn-udp-driver)
|
||||||
(spawn-port-allocator 'udp (lambda () (query-set udp-ports (udp-port-allocation $p _) p)))
|
(spawn-port-allocator 'udp (lambda () (query-set udp-ports (udp-port-allocation $p _) p)))
|
||||||
(spawn-kernel-udp-driver)
|
(spawn-kernel-udp-driver)
|
||||||
(actor #:name 'udp-driver
|
(spawn #:name 'udp-driver
|
||||||
(on (asserted (observe (udp-packet _ ($ h (udp-listener _)) _)))
|
(on (asserted (observe (udp-packet _ ($ h (udp-listener _)) _)))
|
||||||
(spawn-udp-relay (udp-listener-port h) h))
|
(spawn-udp-relay (udp-listener-port h) h))
|
||||||
(on (asserted (observe (udp-packet _ ($ h (udp-handle _)) _)))
|
(on (asserted (observe (udp-packet _ ($ h (udp-handle _)) _)))
|
||||||
(actor #:name (list 'udp-transient h)
|
(spawn #:name (list 'udp-transient h)
|
||||||
(on-start (spawn-udp-relay (allocate-port! 'udp) h))))))
|
(on-start (spawn-udp-relay (allocate-port! 'udp) h))))))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; Relaying
|
;; Relaying
|
||||||
|
|
||||||
(define (spawn-udp-relay local-port local-user-addr)
|
(define (spawn-udp-relay local-port local-user-addr)
|
||||||
(actor #:name (list 'udp-relay local-port local-user-addr)
|
(spawn #:name (list 'udp-relay local-port local-user-addr)
|
||||||
(on-start (log-info "Spawning UDP relay ~v / ~v" local-port local-user-addr))
|
(on-start (log-info "Spawning UDP relay ~v / ~v" local-port local-user-addr))
|
||||||
|
|
||||||
(define any-remote (udp-remote-address ? ?))
|
(define any-remote (udp-remote-address ? ?))
|
||||||
|
@ -97,7 +97,7 @@
|
||||||
(define PROTOCOL-UDP 17)
|
(define PROTOCOL-UDP 17)
|
||||||
|
|
||||||
(define (spawn-kernel-udp-driver)
|
(define (spawn-kernel-udp-driver)
|
||||||
(actor #:name 'kernel-udp-driver
|
(spawn #:name 'kernel-udp-driver
|
||||||
(assert (advertise (ip-packet #f _ _ PROTOCOL-UDP _ _)))
|
(assert (advertise (ip-packet #f _ _ PROTOCOL-UDP _ _)))
|
||||||
|
|
||||||
(define local-ips (query-local-ip-addresses))
|
(define local-ips (query-local-ip-addresses))
|
||||||
|
|
|
@ -215,7 +215,7 @@
|
||||||
(cache-key-address q)))))))
|
(cache-key-address q)))))))
|
||||||
|
|
||||||
(list (set-wakeup-alarm)
|
(list (set-wakeup-alarm)
|
||||||
(spawn (lambda (e s)
|
(actor (lambda (e s)
|
||||||
;; (log-info "ARP ~a ~a: ~v // ~v" interface-name (pretty-bytes hwaddr) e s)
|
;; (log-info "ARP ~a ~a: ~v // ~v" interface-name (pretty-bytes hwaddr) e s)
|
||||||
(match e
|
(match e
|
||||||
[(scn g)
|
[(scn g)
|
||||||
|
|
|
@ -4,22 +4,23 @@
|
||||||
(require racket/match)
|
(require racket/match)
|
||||||
(require syndicate/monolithic)
|
(require syndicate/monolithic)
|
||||||
(require (only-in mzlib/os gethostname))
|
(require (only-in mzlib/os gethostname))
|
||||||
|
(require (only-in racket/string string-split))
|
||||||
(require "configuration.rkt")
|
(require "configuration.rkt")
|
||||||
|
|
||||||
(provide spawn-demo-config)
|
(provide spawn-demo-config)
|
||||||
|
|
||||||
(define (spawn-demo-config)
|
(define (spawn-demo-config)
|
||||||
(spawn (lambda (e s) #f)
|
(actor (lambda (e s) #f)
|
||||||
(void)
|
(void)
|
||||||
(match (gethostname)
|
(match (gethostname)
|
||||||
["skip"
|
|
||||||
(scn/union (assertion (gateway-route (bytes 0 0 0 0) 0 (bytes 192 168 1 1) "en0"))
|
|
||||||
(assertion (host-route (bytes 192 168 1 222) 24 "en0")))]
|
|
||||||
[(or "hop" "walk")
|
|
||||||
(scn/union (assertion (gateway-route (bytes 0 0 0 0) 0 (bytes 192 168 1 1) "wlan0"))
|
|
||||||
(assertion (host-route (bytes 192 168 1 222) 24 "wlan0")))]
|
|
||||||
["stockholm.ccs.neu.edu"
|
["stockholm.ccs.neu.edu"
|
||||||
(scn/union (assertion (host-route (bytes 129 10 115 94) 24 "eth0"))
|
(scn/union (assertion (host-route (bytes 129 10 115 94) 24 "eth0"))
|
||||||
(assertion (gateway-route (bytes 0 0 0 0) 0 (bytes 129 10 115 1) "eth0")))]
|
(assertion (gateway-route (bytes 0 0 0 0) 0 (bytes 129 10 115 1) "eth0")))]
|
||||||
[else
|
[other ;; assume a private network
|
||||||
(error 'spawn-demo-config "No setup for hostname ~a" (gethostname))])))
|
(define interface
|
||||||
|
(match (car (string-split other "."))
|
||||||
|
["skip" "en0"]
|
||||||
|
["leap" "wlp4s0"] ;; wtf
|
||||||
|
[_ "wlan0"]))
|
||||||
|
(scn/union (assertion (gateway-route (bytes 0 0 0 0) 0 (bytes 192 168 1 1) interface))
|
||||||
|
(assertion (host-route (bytes 192 168 1 222) 24 interface)))])))
|
||||||
|
|
|
@ -47,7 +47,7 @@
|
||||||
(log-info "Opened interface ~a, yielding handle ~v" interface-name h)
|
(log-info "Opened interface ~a, yielding handle ~v" interface-name h)
|
||||||
(define control-ch (make-async-channel))
|
(define control-ch (make-async-channel))
|
||||||
(thread (lambda () (interface-packet-read-loop interface h control-ch)))
|
(thread (lambda () (interface-packet-read-loop interface h control-ch)))
|
||||||
(spawn (lambda (e h)
|
(actor (lambda (e h)
|
||||||
(match e
|
(match e
|
||||||
[(scn g)
|
[(scn g)
|
||||||
(if (trie-empty? g)
|
(if (trie-empty? g)
|
||||||
|
|
|
@ -83,7 +83,7 @@
|
||||||
network-addr
|
network-addr
|
||||||
netmask
|
netmask
|
||||||
interface-name))
|
interface-name))
|
||||||
(spawn (lambda (e s)
|
(actor (lambda (e s)
|
||||||
(match e
|
(match e
|
||||||
[(scn (? trie-empty?)) (quit)]
|
[(scn (? trie-empty?)) (quit)]
|
||||||
[(message (ip-packet _ peer-address _ _ _ body))
|
[(message (ip-packet _ peer-address _ _ _ body))
|
||||||
|
@ -143,7 +143,7 @@
|
||||||
(and (positive? msk)
|
(and (positive? msk)
|
||||||
(ip-address-in-subnet? addr net msk))))
|
(ip-address-in-subnet? addr net msk))))
|
||||||
|
|
||||||
(spawn (lambda (e s)
|
(actor (lambda (e s)
|
||||||
(match e
|
(match e
|
||||||
[(scn g)
|
[(scn g)
|
||||||
(define host-ips+netmasks (trie-project/set #:take 2 g host-route-projector))
|
(define host-ips+netmasks (trie-project/set #:take 2 g host-route-projector))
|
||||||
|
@ -202,7 +202,7 @@
|
||||||
;; Normal IP route
|
;; Normal IP route
|
||||||
|
|
||||||
(define (spawn-normal-ip-route the-route network netmask interface-name)
|
(define (spawn-normal-ip-route the-route network netmask interface-name)
|
||||||
(spawn (lambda (e s)
|
(actor (lambda (e s)
|
||||||
(match e
|
(match e
|
||||||
[(scn (? trie-empty?)) (quit)]
|
[(scn (? trie-empty?)) (quit)]
|
||||||
[(message (ethernet-packet _ _ _ _ _ body))
|
[(message (ethernet-packet _ _ _ _ _ body))
|
||||||
|
|
|
@ -34,7 +34,7 @@
|
||||||
(define (say who fmt . vs)
|
(define (say who fmt . vs)
|
||||||
(unless (equal? who user) (send-to-remote "~a ~a\n" who (apply format fmt vs))))
|
(unless (equal? who user) (send-to-remote "~a ~a\n" who (apply format fmt vs))))
|
||||||
(list (send-to-remote "Welcome, ~a.\n" user)
|
(list (send-to-remote "Welcome, ~a.\n" user)
|
||||||
(spawn
|
(actor
|
||||||
(lambda (e peers)
|
(lambda (e peers)
|
||||||
(match e
|
(match e
|
||||||
[(message (inbound (tcp-channel _ _ bs)))
|
[(message (inbound (tcp-channel _ _ bs)))
|
||||||
|
@ -61,14 +61,14 @@
|
||||||
(advertisement (inbound (tcp-channel us them ?))) ;; we will write to remote client
|
(advertisement (inbound (tcp-channel us them ?))) ;; we will write to remote client
|
||||||
))))
|
))))
|
||||||
|
|
||||||
(spawn-dataspace
|
(dataspace-actor
|
||||||
(spawn-demand-matcher (inbound (advertise (tcp-channel (?!) (?! (tcp-listener 5999)) ?)))
|
(spawn-demand-matcher (inbound (advertise (tcp-channel (?!) (?! (tcp-listener 5999)) ?)))
|
||||||
(inbound (observe (tcp-channel (?!) (?! (tcp-listener 5999)) ?)))
|
(inbound (observe (tcp-channel (?!) (?! (tcp-listener 5999)) ?)))
|
||||||
spawn-session))
|
spawn-session))
|
||||||
)
|
)
|
||||||
|
|
||||||
(let ()
|
(let ()
|
||||||
(spawn (lambda (e s)
|
(actor (lambda (e s)
|
||||||
(match e
|
(match e
|
||||||
[(message (udp-packet src dst body))
|
[(message (udp-packet src dst body))
|
||||||
(log-info "Got packet from ~v: ~v" src body)
|
(log-info "Got packet from ~v: ~v" src body)
|
||||||
|
@ -84,7 +84,7 @@
|
||||||
(define (spawn-session them us)
|
(define (spawn-session them us)
|
||||||
(list
|
(list
|
||||||
(message 'bump)
|
(message 'bump)
|
||||||
(spawn (lambda (e s)
|
(actor (lambda (e s)
|
||||||
(match e
|
(match e
|
||||||
[(message `(counter ,counter))
|
[(message `(counter ,counter))
|
||||||
(define response
|
(define response
|
||||||
|
@ -105,8 +105,8 @@
|
||||||
(subscription (inbound (advertise (tcp-channel them us ?))))
|
(subscription (inbound (advertise (tcp-channel them us ?))))
|
||||||
(advertisement (inbound (tcp-channel us them ?)))))))
|
(advertisement (inbound (tcp-channel us them ?)))))))
|
||||||
|
|
||||||
(spawn-dataspace
|
(dataspace-actor
|
||||||
(spawn (lambda (e counter)
|
(actor (lambda (e counter)
|
||||||
(match e
|
(match e
|
||||||
[(message 'bump)
|
[(message 'bump)
|
||||||
(transition (+ counter 1) (message `(counter ,counter)))]
|
(transition (+ counter 1) (message `(counter ,counter)))]
|
||||||
|
|
|
@ -10,14 +10,14 @@
|
||||||
;; -> Action
|
;; -> Action
|
||||||
;; Spawns a process that observes the given projections. Any time the
|
;; Spawns a process that observes the given projections. Any time the
|
||||||
;; environment's interests change in a relevant way, calls
|
;; environment's interests change in a relevant way, calls
|
||||||
;; check-and-maybe-spawn-fn with the aggregate interests and the
|
;; check-and-maybe-actor-fn with the aggregate interests and the
|
||||||
;; projection results. If check-and-maybe-spawn-fn returns #f,
|
;; projection results. If check-and-maybe-actor-fn returns #f,
|
||||||
;; continues to wait; otherwise, takes the action(s) returned, and
|
;; continues to wait; otherwise, takes the action(s) returned, and
|
||||||
;; quits.
|
;; quits.
|
||||||
(define (on-claim #:timeout-msec [timeout-msec #f]
|
(define (on-claim #:timeout-msec [timeout-msec #f]
|
||||||
#:on-timeout [timeout-handler (lambda () '())]
|
#:on-timeout [timeout-handler (lambda () '())]
|
||||||
#:name [name #f]
|
#:name [name #f]
|
||||||
check-and-maybe-spawn-fn
|
check-and-maybe-actor-fn
|
||||||
base-interests
|
base-interests
|
||||||
. projections)
|
. projections)
|
||||||
(define timer-id (gensym 'on-claim))
|
(define timer-id (gensym 'on-claim))
|
||||||
|
@ -27,18 +27,18 @@
|
||||||
(define projection-results
|
(define projection-results
|
||||||
(map (lambda (p) (trie-project/set #:take (projection-arity p) new-aggregate p))
|
(map (lambda (p) (trie-project/set #:take (projection-arity p) new-aggregate p))
|
||||||
projections))
|
projections))
|
||||||
(define maybe-spawn (apply check-and-maybe-spawn-fn
|
(define maybe-actor (apply check-and-maybe-actor-fn
|
||||||
new-aggregate
|
new-aggregate
|
||||||
projection-results))
|
projection-results))
|
||||||
(if maybe-spawn
|
(if maybe-actor
|
||||||
(quit maybe-spawn)
|
(quit maybe-actor)
|
||||||
#f)]
|
#f)]
|
||||||
[(message (timer-expired (== timer-id) _))
|
[(message (timer-expired (== timer-id) _))
|
||||||
(quit (timeout-handler))]
|
(quit (timeout-handler))]
|
||||||
[_ #f]))
|
[_ #f]))
|
||||||
(list
|
(list
|
||||||
(when timeout-msec (message (set-timer timer-id timeout-msec 'relative)))
|
(when timeout-msec (message (set-timer timer-id timeout-msec 'relative)))
|
||||||
(spawn #:name name
|
(actor #:name name
|
||||||
on-claim-handler
|
on-claim-handler
|
||||||
(void)
|
(void)
|
||||||
(scn/union base-interests
|
(scn/union base-interests
|
||||||
|
|
|
@ -14,7 +14,7 @@
|
||||||
(struct port-allocator-state (used-ports local-ips) #:transparent)
|
(struct port-allocator-state (used-ports local-ips) #:transparent)
|
||||||
|
|
||||||
(define (spawn-port-allocator allocator-type observer-gestalt compute-used-ports)
|
(define (spawn-port-allocator allocator-type observer-gestalt compute-used-ports)
|
||||||
(spawn #:name (string->symbol (format "port-allocator:~a" allocator-type))
|
(actor #:name (string->symbol (format "port-allocator:~a" allocator-type))
|
||||||
(lambda (e s)
|
(lambda (e s)
|
||||||
(match e
|
(match e
|
||||||
[(scn g)
|
[(scn g)
|
||||||
|
|
|
@ -59,7 +59,7 @@
|
||||||
(match-define (tcp-listener port) server-addr)
|
(match-define (tcp-listener port) server-addr)
|
||||||
;; TODO: have listener shut down once user-level listener does
|
;; TODO: have listener shut down once user-level listener does
|
||||||
(list
|
(list
|
||||||
(spawn #:name (string->symbol
|
(actor #:name (string->symbol
|
||||||
(format "tcp-listener-port-reservation:~a" port))
|
(format "tcp-listener-port-reservation:~a" port))
|
||||||
(lambda (e s) #f)
|
(lambda (e s) #f)
|
||||||
(void)
|
(void)
|
||||||
|
@ -122,7 +122,7 @@
|
||||||
(define remote-peer-traffic (?! (advertise (tcp-channel remote-addr local-tcp-addr ?))))
|
(define remote-peer-traffic (?! (advertise (tcp-channel remote-addr local-tcp-addr ?))))
|
||||||
(list
|
(list
|
||||||
(message (set-timer timer-name relay-peer-wait-time-msec 'relative))
|
(message (set-timer timer-name relay-peer-wait-time-msec 'relative))
|
||||||
(spawn #:name (string->symbol (format "tcp-relay:~v:~v:~v"
|
(actor #:name (string->symbol (format "tcp-relay:~v:~v:~v"
|
||||||
local-user-addr
|
local-user-addr
|
||||||
remote-addr
|
remote-addr
|
||||||
local-tcp-addr))
|
local-tcp-addr))
|
||||||
|
@ -294,7 +294,7 @@
|
||||||
(transition s (message (ip-packet #f src-ip dst-ip PROTOCOL-TCP #""
|
(transition s (message (ip-packet #f src-ip dst-ip PROTOCOL-TCP #""
|
||||||
(ip-checksum 16 payload #:pseudo-header pseudo-header)))))
|
(ip-checksum 16 payload #:pseudo-header pseudo-header)))))
|
||||||
|
|
||||||
(spawn #:name 'kernel-tcp-driver
|
(actor #:name 'kernel-tcp-driver
|
||||||
(lambda (e s)
|
(lambda (e s)
|
||||||
(match e
|
(match e
|
||||||
[(scn g)
|
[(scn g)
|
||||||
|
@ -655,7 +655,7 @@
|
||||||
(current-inexact-milliseconds)
|
(current-inexact-milliseconds)
|
||||||
#f
|
#f
|
||||||
#f)))
|
#f)))
|
||||||
(spawn #:name
|
(actor #:name
|
||||||
(string->symbol (format "tcp-state-vector:~a:~a:~a:~a"
|
(string->symbol (format "tcp-state-vector:~a:~a:~a:~a"
|
||||||
(ip-address->hostname src-ip)
|
(ip-address->hostname src-ip)
|
||||||
src-port
|
src-port
|
||||||
|
|
|
@ -92,7 +92,7 @@
|
||||||
(subscription (udp-datagram ? ? ip local-port ?))
|
(subscription (udp-datagram ? ? ip local-port ?))
|
||||||
(advertisement (udp-datagram ip local-port ? ? ?)))))
|
(advertisement (udp-datagram ip local-port ? ? ?)))))
|
||||||
|
|
||||||
(spawn (lambda (e local-ips)
|
(actor (lambda (e local-ips)
|
||||||
(match e
|
(match e
|
||||||
[(scn g)
|
[(scn g)
|
||||||
(define new-local-ips (gestalt->local-ip-addresses g))
|
(define new-local-ips (gestalt->local-ip-addresses g))
|
||||||
|
@ -124,7 +124,7 @@
|
||||||
(define PROTOCOL-UDP 17)
|
(define PROTOCOL-UDP 17)
|
||||||
|
|
||||||
(define (spawn-kernel-udp-driver)
|
(define (spawn-kernel-udp-driver)
|
||||||
(spawn (lambda (e local-ips)
|
(actor (lambda (e local-ips)
|
||||||
(match e
|
(match e
|
||||||
[(scn g)
|
[(scn g)
|
||||||
(transition (gestalt->local-ip-addresses g) '())]
|
(transition (gestalt->local-ip-addresses g) '())]
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
#lang syndicate/actor
|
#lang syndicate
|
||||||
|
|
||||||
(require racket/file)
|
(require racket/file)
|
||||||
(require racket/serialize)
|
(require racket/serialize)
|
||||||
|
@ -18,11 +18,11 @@
|
||||||
(define cmdline-port (make-parameter 5889))
|
(define cmdline-port (make-parameter 5889))
|
||||||
(define cmdline-filenames (make-parameter '()))
|
(define cmdline-filenames (make-parameter '()))
|
||||||
|
|
||||||
(actor* (for [(filename (cmdline-filenames))]
|
(spawn* (for [(filename (cmdline-filenames))]
|
||||||
(run-one-server filename)))
|
(run-one-server filename)))
|
||||||
|
|
||||||
(define (run-one-server filename)
|
(define (run-one-server filename)
|
||||||
(actor (field [state (make-server (simple-document
|
(spawn (field [state (make-server (simple-document
|
||||||
(if (file-exists? filename)
|
(if (file-exists? filename)
|
||||||
(begin (log-info "loading ~v" filename)
|
(begin (log-info "loading ~v" filename)
|
||||||
(file->string filename))
|
(file->string filename))
|
||||||
|
@ -51,10 +51,10 @@
|
||||||
(define sp (extract-operation (state)))
|
(define sp (extract-operation (state)))
|
||||||
(when sp (send! (accepted-op filename sp))))))
|
(when sp (send! (accepted-op filename sp))))))
|
||||||
|
|
||||||
(actor (define s (tcp-listener (cmdline-port)))
|
(spawn (define s (tcp-listener (cmdline-port)))
|
||||||
(on-start (log-info "listening on port ~v" (cmdline-port)))
|
(on-start (log-info "listening on port ~v" (cmdline-port)))
|
||||||
(assert (advertise (observe (tcp-channel _ s _))))
|
(assert (advertise (observe (tcp-channel _ s _))))
|
||||||
(during/actor (advertise (tcp-channel $c s _))
|
(during/spawn (advertise (tcp-channel $c s _))
|
||||||
(assert (advertise (tcp-channel s c _)))
|
(assert (advertise (tcp-channel s c _)))
|
||||||
(on-start (log-info "~a: connected" c))
|
(on-start (log-info "~a: connected" c))
|
||||||
(on-stop (log-info "~a: disconnected" c))
|
(on-stop (log-info "~a: disconnected" c))
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
#lang syndicate/actor
|
#lang syndicate
|
||||||
|
|
||||||
(require racket/file)
|
(require racket/file)
|
||||||
(require racket/serialize)
|
(require racket/serialize)
|
||||||
|
@ -16,7 +16,7 @@
|
||||||
(define cmdline-port (make-parameter 5888))
|
(define cmdline-port (make-parameter 5888))
|
||||||
(define cmdline-filename (make-parameter "info.rkt"))
|
(define cmdline-filename (make-parameter "info.rkt"))
|
||||||
|
|
||||||
(actor (field [state (make-server (simple-document
|
(spawn (field [state (make-server (simple-document
|
||||||
(if (file-exists? (cmdline-filename))
|
(if (file-exists? (cmdline-filename))
|
||||||
(begin (log-info "loading ~v" (cmdline-filename))
|
(begin (log-info "loading ~v" (cmdline-filename))
|
||||||
(file->string (cmdline-filename)))
|
(file->string (cmdline-filename)))
|
||||||
|
@ -45,10 +45,10 @@
|
||||||
(define sp (extract-operation (state)))
|
(define sp (extract-operation (state)))
|
||||||
(when sp (send! (accepted-op sp)))))
|
(when sp (send! (accepted-op sp)))))
|
||||||
|
|
||||||
(actor (define s (tcp-listener (cmdline-port)))
|
(spawn (define s (tcp-listener (cmdline-port)))
|
||||||
(on-start (log-info "listening on port ~v" (cmdline-port)))
|
(on-start (log-info "listening on port ~v" (cmdline-port)))
|
||||||
(assert (advertise (observe (tcp-channel _ s _))))
|
(assert (advertise (observe (tcp-channel _ s _))))
|
||||||
(during/actor (advertise (tcp-channel $c s _))
|
(during/spawn (advertise (tcp-channel $c s _))
|
||||||
(assert (advertise (tcp-channel s c _)))
|
(assert (advertise (tcp-channel s c _)))
|
||||||
(on-start (log-info "~a: connected" c))
|
(on-start (log-info "~a: connected" c))
|
||||||
(on-stop (log-info "~a: disconnected" c))
|
(on-stop (log-info "~a: disconnected" c))
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
#lang syndicate/actor
|
#lang syndicate
|
||||||
|
|
||||||
(require 2htdp/image)
|
(require 2htdp/image)
|
||||||
(require 2htdp/planetcute)
|
(require 2htdp/planetcute)
|
||||||
|
@ -302,7 +302,7 @@
|
||||||
;; SceneManager
|
;; SceneManager
|
||||||
|
|
||||||
(define (spawn-scene-manager)
|
(define (spawn-scene-manager)
|
||||||
(actor #:name 'scene-manager
|
(spawn #:name 'scene-manager
|
||||||
(define backdrop (rectangle 1 1 "solid" "white"))
|
(define backdrop (rectangle 1 1 "solid" "white"))
|
||||||
|
|
||||||
(define/query-value size (vector 0 0) (inbound (window $x $y)) (vector x y))
|
(define/query-value size (vector 0 0) (inbound (window $x $y)) (vector x y))
|
||||||
|
@ -337,7 +337,7 @@
|
||||||
;; ScoreKeeper
|
;; ScoreKeeper
|
||||||
|
|
||||||
(define (spawn-score-keeper)
|
(define (spawn-score-keeper)
|
||||||
(actor #:name 'score-keeper
|
(spawn #:name 'score-keeper
|
||||||
(field [score 0])
|
(field [score 0])
|
||||||
(assert (current-score (score)))
|
(assert (current-score (score)))
|
||||||
(assert (outbound
|
(assert (outbound
|
||||||
|
@ -356,7 +356,7 @@
|
||||||
(define gravity 0.004)
|
(define gravity 0.004)
|
||||||
|
|
||||||
(define (spawn-physics-engine)
|
(define (spawn-physics-engine)
|
||||||
(actor #:name 'physics-engine
|
(spawn #:name 'physics-engine
|
||||||
(field [configs (hash)]
|
(field [configs (hash)]
|
||||||
[previous-positions (hash)]
|
[previous-positions (hash)]
|
||||||
[previous-velocities (hash)]
|
[previous-velocities (hash)]
|
||||||
|
@ -535,7 +535,7 @@
|
||||||
(define planetcute-scale 1/2)
|
(define planetcute-scale 1/2)
|
||||||
|
|
||||||
(define (spawn-player-avatar initial-focus-x initial-focus-y)
|
(define (spawn-player-avatar initial-focus-x initial-focus-y)
|
||||||
(actor #:name 'player-avatar
|
(spawn #:name 'player-avatar
|
||||||
(define i (icon character-cat-girl planetcute-scale 2/6 3/10 13/16))
|
(define i (icon character-cat-girl planetcute-scale 2/6 3/10 13/16))
|
||||||
(define initial-top-left (focus->top-left i initial-focus-x initial-focus-y))
|
(define initial-top-left (focus->top-left i initial-focus-x initial-focus-y))
|
||||||
|
|
||||||
|
@ -550,7 +550,7 @@
|
||||||
|
|
||||||
(field [hit-points 1])
|
(field [hit-points 1])
|
||||||
(assert (health player-id (hit-points)))
|
(assert (health player-id (hit-points)))
|
||||||
(stop-when (rising-edge (<= (hit-points) 0)))
|
(stop-when-true (<= (hit-points) 0))
|
||||||
(on (message (damage player-id $amount))
|
(on (message (damage player-id $amount))
|
||||||
(hit-points (- (hit-points) amount)))
|
(hit-points (- (hit-points) amount)))
|
||||||
|
|
||||||
|
@ -567,7 +567,7 @@
|
||||||
;; Ground Block
|
;; Ground Block
|
||||||
|
|
||||||
(define (spawn-ground-block top-left size #:color [color "purple"])
|
(define (spawn-ground-block top-left size #:color [color "purple"])
|
||||||
(actor #:name (list 'ground-block top-left size color)
|
(spawn #:name (list 'ground-block top-left size color)
|
||||||
(match-define (vector x y) top-left)
|
(match-define (vector x y) top-left)
|
||||||
(match-define (vector w h) size)
|
(match-define (vector w h) size)
|
||||||
(define block-id (gensym 'ground-block))
|
(define block-id (gensym 'ground-block))
|
||||||
|
@ -589,7 +589,7 @@
|
||||||
(define i (icon key planetcute-scale 1/3 2/5 4/5))
|
(define i (icon key planetcute-scale 1/3 2/5 4/5))
|
||||||
(define initial-top-left (focus->top-left i initial-focus-x initial-focus-y))
|
(define initial-top-left (focus->top-left i initial-focus-x initial-focus-y))
|
||||||
|
|
||||||
(actor #:name (list 'goal-piece initial-focus-x initial-focus-y)
|
(spawn #:name (list 'goal-piece initial-focus-x initial-focus-y)
|
||||||
(on (asserted (touching player-id goal-id _))
|
(on (asserted (touching player-id goal-id _))
|
||||||
(send! (outbound (level-completed))))
|
(send! (outbound (level-completed))))
|
||||||
(assert (game-piece-configuration goal-id
|
(assert (game-piece-configuration goal-id
|
||||||
|
@ -604,7 +604,7 @@
|
||||||
(define (spawn-enemy initial-x initial-y range-lo range-hi
|
(define (spawn-enemy initial-x initial-y range-lo range-hi
|
||||||
#:speed [speed 0.2]
|
#:speed [speed 0.2]
|
||||||
#:facing [initial-facing 'right])
|
#:facing [initial-facing 'right])
|
||||||
(actor #:name (list 'enemy initial-x initial-y initial-facing)
|
(spawn #:name (list 'enemy initial-x initial-y initial-facing)
|
||||||
(define enemy-id (gensym 'enemy))
|
(define enemy-id (gensym 'enemy))
|
||||||
(define i (icon enemy-bug planetcute-scale 9/10 1/3 5/6))
|
(define i (icon enemy-bug planetcute-scale 9/10 1/3 5/6))
|
||||||
(define i-flipped (struct-copy icon i [pict (flip-horizontal (icon-pict i))]))
|
(define i-flipped (struct-copy icon i [pict (flip-horizontal (icon-pict i))]))
|
||||||
|
@ -624,9 +624,9 @@
|
||||||
[(> (+ left width) range-hi) 'left]
|
[(> (+ left width) range-hi) 'left]
|
||||||
[else (facing)]))))
|
[else (facing)]))))
|
||||||
|
|
||||||
(stop-when (rising-edge (and (current-level-size)
|
(stop-when-true (and (current-level-size)
|
||||||
(> (vector-ref (pos) 1)
|
(> (vector-ref (pos) 1)
|
||||||
(vector-ref (current-level-size) 1)))))
|
(vector-ref (current-level-size) 1))))
|
||||||
|
|
||||||
(field [facing initial-facing])
|
(field [facing initial-facing])
|
||||||
(assert (outbound* game-level
|
(assert (outbound* game-level
|
||||||
|
@ -647,7 +647,7 @@
|
||||||
(define (spawn-display-controller level-size-vec)
|
(define (spawn-display-controller level-size-vec)
|
||||||
(match-define (vector level-width level-height) level-size-vec)
|
(match-define (vector level-width level-height) level-size-vec)
|
||||||
|
|
||||||
(actor #:name 'display-controller
|
(spawn #:name 'display-controller
|
||||||
(field [offset-pos (vector 0 0)])
|
(field [offset-pos (vector 0 0)])
|
||||||
(assert (outbound* 2 (scroll-offset (offset-pos))))
|
(assert (outbound* 2 (scroll-offset (offset-pos))))
|
||||||
(assert (level-size level-size-vec))
|
(assert (level-size level-size-vec))
|
||||||
|
@ -671,23 +671,23 @@
|
||||||
;; kills the dataspace.
|
;; kills the dataspace.
|
||||||
|
|
||||||
(define (wait-for-level-termination)
|
(define (wait-for-level-termination)
|
||||||
(react/suspend (done)
|
(spawn
|
||||||
(assert (outbound (level-running)))
|
(assert (outbound (level-running)))
|
||||||
(stop-when (retracted (game-piece-configuration player-id _ _ _))
|
(on (retracted (game-piece-configuration player-id _ _ _))
|
||||||
(log-info "Player died! Terminating level.")
|
(log-info "Player died! Terminating level.")
|
||||||
(play-sound-sequence 270328)
|
(play-sound-sequence 270328)
|
||||||
(done))
|
(quit-dataspace!))
|
||||||
(stop-when (message (inbound (level-completed)))
|
(on (message (inbound (level-completed)))
|
||||||
(log-info "Level completed! Terminating level.")
|
(log-info "Level completed! Terminating level.")
|
||||||
(play-sound-sequence 270330)
|
(play-sound-sequence 270330)
|
||||||
(send! (outbound (add-to-score 100)))
|
(send! (outbound (add-to-score 100)))
|
||||||
(done))))
|
(quit-dataspace!))))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; LevelSpawner
|
;; LevelSpawner
|
||||||
|
|
||||||
(define (spawn-standalone-assertions . patches)
|
(define (spawn-standalone-assertions . patches)
|
||||||
(actor #:name 'standalone-assertions
|
(spawn #:name 'standalone-assertions
|
||||||
(on-start (patch! (patch-seq* patches)))))
|
(on-start (patch! (patch-seq* patches)))))
|
||||||
|
|
||||||
(define (spawn-background-image level-size scene)
|
(define (spawn-background-image level-size scene)
|
||||||
|
@ -778,7 +778,7 @@
|
||||||
message))))))
|
message))))))
|
||||||
|
|
||||||
(define (spawn-level-spawner starting-level)
|
(define (spawn-level-spawner starting-level)
|
||||||
(actor #:name 'level-spawner
|
(spawn #:name 'level-spawner
|
||||||
(field [current-level starting-level]
|
(field [current-level starting-level]
|
||||||
[level-complete? #f])
|
[level-complete? #f])
|
||||||
|
|
||||||
|
@ -816,5 +816,4 @@
|
||||||
(spawn-keyboard-integrator)
|
(spawn-keyboard-integrator)
|
||||||
(spawn-scene-manager)
|
(spawn-scene-manager)
|
||||||
(dataspace (spawn-score-keeper)
|
(dataspace (spawn-score-keeper)
|
||||||
(spawn-level-spawner 0)
|
(spawn-level-spawner 0))
|
||||||
(forever))
|
|
||||||
|
|
|
@ -335,7 +335,7 @@
|
||||||
p
|
p
|
||||||
(?! (on-screen-display ? ? ?)))]))
|
(?! (on-screen-display ? ? ?)))]))
|
||||||
|
|
||||||
(spawn (lambda (e s)
|
(actor (lambda (e s)
|
||||||
(match e
|
(match e
|
||||||
[(? patch? p)
|
[(? patch? p)
|
||||||
(let* ((s (update-window-size s p))
|
(let* ((s (update-window-size s p))
|
||||||
|
@ -381,7 +381,7 @@
|
||||||
(define i (text (format "Score: ~a" new-score) 24 "white"))
|
(define i (text (format "Score: ~a" new-score) 24 "white"))
|
||||||
(patch-seq (retract (outbound (on-screen-display ? ? ?)))
|
(patch-seq (retract (outbound (on-screen-display ? ? ?)))
|
||||||
(assert (outbound (on-screen-display -150 10 (seal i))))))
|
(assert (outbound (on-screen-display -150 10 (seal i))))))
|
||||||
(spawn (lambda (e s)
|
(actor (lambda (e s)
|
||||||
(match e
|
(match e
|
||||||
[(message (add-to-score delta))
|
[(message (add-to-score delta))
|
||||||
(define new-score (+ s delta))
|
(define new-score (+ s delta))
|
||||||
|
@ -603,7 +603,7 @@
|
||||||
(play-sound-sequence 270318)
|
(play-sound-sequence 270318)
|
||||||
((update-piece g pos (v+ pos (vector 0 -1)) jump-vel) s)))
|
((update-piece g pos (v+ pos (vector 0 -1)) jump-vel) s)))
|
||||||
|
|
||||||
(spawn (lambda (e s)
|
(actor (lambda (e s)
|
||||||
(match e
|
(match e
|
||||||
[(? patch? p)
|
[(? patch? p)
|
||||||
(sequence-transitions (transition s '())
|
(sequence-transitions (transition s '())
|
||||||
|
@ -679,7 +679,7 @@
|
||||||
(patch-seq (retract (impulse player-id ?))
|
(patch-seq (retract (impulse player-id ?))
|
||||||
(assert (impulse player-id (vector h-impulse 0)))))))
|
(assert (impulse player-id (vector h-impulse 0)))))))
|
||||||
|
|
||||||
(spawn (lambda (e s)
|
(actor (lambda (e s)
|
||||||
(match e
|
(match e
|
||||||
[(? patch? p)
|
[(? patch? p)
|
||||||
(sequence-transitions (transition s '())
|
(sequence-transitions (transition s '())
|
||||||
|
@ -720,7 +720,7 @@
|
||||||
(match-define (vector w h) size)
|
(match-define (vector w h) size)
|
||||||
(define block-id (gensym 'ground-block))
|
(define block-id (gensym 'ground-block))
|
||||||
(define block-pict (rectangle w h "solid" color))
|
(define block-pict (rectangle w h "solid" color))
|
||||||
(spawn (lambda (e s)
|
(actor (lambda (e s)
|
||||||
(match e
|
(match e
|
||||||
[_ #f]))
|
[_ #f]))
|
||||||
(void)
|
(void)
|
||||||
|
@ -742,7 +742,7 @@
|
||||||
(define i (icon key planetcute-scale 1/3 2/5 4/5))
|
(define i (icon key planetcute-scale 1/3 2/5 4/5))
|
||||||
(define initial-top-left (focus->top-left i initial-focus-x initial-focus-y))
|
(define initial-top-left (focus->top-left i initial-focus-x initial-focus-y))
|
||||||
|
|
||||||
(spawn (lambda (e s)
|
(actor (lambda (e s)
|
||||||
(match e
|
(match e
|
||||||
[(? patch/added?) (transition s (message (outbound (level-completed))))]
|
[(? patch/added?) (transition s (message (outbound (level-completed))))]
|
||||||
[_ #f]))
|
[_ #f]))
|
||||||
|
@ -824,7 +824,7 @@
|
||||||
(quit (list damage-actions (message (outbound (add-to-score 1))))))
|
(quit (list damage-actions (message (outbound (add-to-score 1))))))
|
||||||
(transition s damage-actions)))
|
(transition s damage-actions)))
|
||||||
|
|
||||||
(spawn (lambda (e s)
|
(actor (lambda (e s)
|
||||||
(match e
|
(match e
|
||||||
[(? patch? p)
|
[(? patch? p)
|
||||||
(sequence-transitions (transition s '())
|
(sequence-transitions (transition s '())
|
||||||
|
@ -874,7 +874,7 @@
|
||||||
(patch-seq (retract (outbound* 2 (scroll-offset ?)))
|
(patch-seq (retract (outbound* 2 (scroll-offset ?)))
|
||||||
(assert (outbound* 2 (scroll-offset offset-pos))))))))))
|
(assert (outbound* 2 (scroll-offset offset-pos))))))))))
|
||||||
|
|
||||||
(spawn (lambda (e s)
|
(actor (lambda (e s)
|
||||||
(match e
|
(match e
|
||||||
[(? patch? p)
|
[(? patch? p)
|
||||||
(sequence-transitions (transition s '())
|
(sequence-transitions (transition s '())
|
||||||
|
@ -893,7 +893,7 @@
|
||||||
;; kills the dataspace.
|
;; kills the dataspace.
|
||||||
|
|
||||||
(define (spawn-level-termination-monitor)
|
(define (spawn-level-termination-monitor)
|
||||||
(spawn (lambda (e s)
|
(actor (lambda (e s)
|
||||||
(match e
|
(match e
|
||||||
[(? patch/removed?)
|
[(? patch/removed?)
|
||||||
(log-info "Player died! Terminating level.")
|
(log-info "Player died! Terminating level.")
|
||||||
|
@ -914,7 +914,7 @@
|
||||||
;; LevelSpawner
|
;; LevelSpawner
|
||||||
|
|
||||||
(define (spawn-standalone-assertions . patches)
|
(define (spawn-standalone-assertions . patches)
|
||||||
(spawn (lambda (e s) #f)
|
(actor (lambda (e s) #f)
|
||||||
(void)
|
(void)
|
||||||
patches))
|
patches))
|
||||||
|
|
||||||
|
@ -942,7 +942,7 @@
|
||||||
#:level-size [level-size-vec (vector 4000 2000)]
|
#:level-size [level-size-vec (vector 4000 2000)]
|
||||||
#:scene [scene grassland-backdrop]
|
#:scene [scene grassland-backdrop]
|
||||||
. actions)
|
. actions)
|
||||||
(spawn-dataspace
|
(dataspace-actor
|
||||||
(and scene (spawn-background-image level-size-vec scene))
|
(and scene (spawn-background-image level-size-vec scene))
|
||||||
(spawn-display-controller level-size-vec)
|
(spawn-display-controller level-size-vec)
|
||||||
(spawn-physics-engine)
|
(spawn-physics-engine)
|
||||||
|
@ -1005,7 +1005,7 @@
|
||||||
(define (spawn-level-spawner starting-level)
|
(define (spawn-level-spawner starting-level)
|
||||||
(struct level-spawner-state (current-level level-complete?) #:prefab)
|
(struct level-spawner-state (current-level level-complete?) #:prefab)
|
||||||
|
|
||||||
(list (spawn (lambda (e s)
|
(list (actor (lambda (e s)
|
||||||
(match-define (level-spawner-state current-level level-complete?) s)
|
(match-define (level-spawner-state current-level level-complete?) s)
|
||||||
(match e
|
(match e
|
||||||
[(? patch/removed?)
|
[(? patch/removed?)
|
||||||
|
@ -1045,5 +1045,5 @@
|
||||||
((2d-dataspace #:width 600 #:height 400)
|
((2d-dataspace #:width 600 #:height 400)
|
||||||
(spawn-keyboard-integrator)
|
(spawn-keyboard-integrator)
|
||||||
(spawn-scene-manager)
|
(spawn-scene-manager)
|
||||||
(spawn-dataspace (spawn-score-keeper)
|
(dataspace-actor (spawn-score-keeper)
|
||||||
(spawn-level-spawner 0)))
|
(spawn-level-spawner 0)))
|
||||||
|
|
|
@ -0,0 +1,38 @@
|
||||||
|
## Sorting out contact states
|
||||||
|
|
||||||
|
### Design
|
||||||
|
|
||||||
|
Contacts are symmetric: If A follows B, then B follows A.
|
||||||
|
|
||||||
|
Let's look at how the state of the A/B relationship changes:
|
||||||
|
|
||||||
|
- Initial state: neither A nor B follows the other.
|
||||||
|
- ACTION: A adds B to their contacts
|
||||||
|
- A proposes an A/B link.
|
||||||
|
- ACTION: A may cancel the proposition
|
||||||
|
- Return to initial state.
|
||||||
|
- ACTION: B may approve the proposition
|
||||||
|
- A/B link established.
|
||||||
|
- ACTION: B may reject the proposition
|
||||||
|
- Return to initial state.
|
||||||
|
- ACTION: B may ignore the proposition
|
||||||
|
- B's user interface no longer displays the request,
|
||||||
|
but if B subsequently proposes an A/B link, it is
|
||||||
|
as if B approved the previously-proposed link.
|
||||||
|
|
||||||
|
- From "A/B link established":
|
||||||
|
- ACTION: A may cancel the link
|
||||||
|
- Return to initial state.
|
||||||
|
- ACTION: B may cancel the link
|
||||||
|
- Return to initial state.
|
||||||
|
|
||||||
|
B should appear in A's contact list in any of these cases:
|
||||||
|
|
||||||
|
1. A has proposed an A/B link.
|
||||||
|
2. An A/B link exists.
|
||||||
|
|
||||||
|
In the first case, B should appear as a "pending link request": as
|
||||||
|
offline, with a "cancel link request" action available.
|
||||||
|
|
||||||
|
In the second case, B should appear as fully linked, either offline or
|
||||||
|
online, with a "delete contact" action available.
|
|
@ -0,0 +1,49 @@
|
||||||
|
<?xml version="1.0"?>
|
||||||
|
<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" height="48px" width="48px">
|
||||||
|
<defs>
|
||||||
|
<radialGradient id="b" gradientUnits="userSpaceOnUse" cy="42.1" cx="24.31" gradientTransform="matrix(1.076 0 0 .285-1.85 30.8)" r="15.82">
|
||||||
|
<stop offset="0"/>
|
||||||
|
<stop stop-opacity="0" offset="1"/>
|
||||||
|
</radialGradient>
|
||||||
|
<radialGradient id="f" gradientUnits="userSpaceOnUse" cy="35.74" cx="33.97" gradientTransform="scale(.961 1.041)" r="86.7">
|
||||||
|
<stop stop-color="#fafafa" offset="0"/>
|
||||||
|
<stop stop-color="#bbb" offset="1"/>
|
||||||
|
</radialGradient>
|
||||||
|
<radialGradient id="g" gradientUnits="userSpaceOnUse" cy="3.76" cx="8.82" gradientTransform="matrix(.968 0 0 1.033 3.35.65)" r="37.75">
|
||||||
|
<stop stop-color="#a3a3a3" offset="0"/>
|
||||||
|
<stop stop-color="#4c4c4c" offset="1"/>
|
||||||
|
</radialGradient>
|
||||||
|
<radialGradient id="e" gradientUnits="userSpaceOnUse" cy="7.27" cx="8.14" gradientTransform="matrix(.968 0 0 1.033 3.35.65)" r="38.2">
|
||||||
|
<stop stop-color="#fff" offset="0"/>
|
||||||
|
<stop stop-color="#f8f8f8" offset="1"/>
|
||||||
|
</radialGradient>
|
||||||
|
<radialGradient id="c" gradientUnits="userSpaceOnUse" cy="18.82" cx="10.1" r="1.21">
|
||||||
|
<stop stop-color="#f0f0f0" offset="0"/>
|
||||||
|
<stop stop-color="#9a9a9a" offset="1"/>
|
||||||
|
</radialGradient>
|
||||||
|
</defs>
|
||||||
|
<ellipse opacity=".8" rx="17" ry="4.5" cy="42.8" cx="24.3" fill="url(#b)"/>
|
||||||
|
<rect rx="1.2" height="41" width="34.88" stroke="url(#g)" y="3.65" x="6.6" fill="url(#f)"/>
|
||||||
|
<rect rx=".2" height="39" width="32.78" stroke="url(#e)" y="4.58" x="7.66" fill="none"/>
|
||||||
|
<g fill="none">
|
||||||
|
<path stroke="#000" d="m11.5 5.4v37.9" stroke-opacity=".02"/>
|
||||||
|
<path stroke="#fff" d="m12.5 5v38" stroke-opacity=".2"/>
|
||||||
|
</g>
|
||||||
|
<g fill-opacity=".55" fill="#9b9b9b">
|
||||||
|
<g id="a">
|
||||||
|
<rect rx=".2" height="1" width="20" y="9" x="16"/>
|
||||||
|
<rect rx=".2" height="1" width="20" y="11" x="16"/>
|
||||||
|
<rect rx=".2" height="1" width="20" y="13" x="16"/>
|
||||||
|
<rect rx=".2" height="1" width="20" y="15" x="16"/>
|
||||||
|
</g>
|
||||||
|
<rect rx=".2" height="1" width="9" y="25" x="16"/>
|
||||||
|
<rect rx=".2" height="1" width="14" y="37" x="16"/>
|
||||||
|
<use y="8" xlink:href="#a"/>
|
||||||
|
<use y="20" xlink:href="#a"/>
|
||||||
|
</g>
|
||||||
|
<g id="d">
|
||||||
|
<circle cy="18.69" cx="10.17" r="0.82" fill="#fff"/>
|
||||||
|
<circle cy="18.43" cx="9.82" r="0.82" fill="url(#c)"/>
|
||||||
|
</g>
|
||||||
|
<use xlink:href="#d" y="11.5"/>
|
||||||
|
</svg>
|
After Width: | Height: | Size: 2.2 KiB |
|
@ -0,0 +1 @@
|
||||||
|
"use strict";!function(t,r){var n=function(t){function r(t){return t.replace(/&/g,"&").replace(/</g,"<").replace(/>/g,">")}function n(t){return t.replace(/"/g,""")}function e(t){if(!t)return"";var r=[];for(var e in t){var i=t[e]+"";r.push(e+'="'+n(i)+'"')}return r.join(" ")}function i(t){var i=arguments.length<=1||void 0===arguments[1]?{}:arguments[1];i=new u(i);for(var a=o(t),f=[],l=0;l<a.length;l++){var s=a[l];if("nl"===s.type&&i.nl2br)f.push("<br>\n");else if(s.isLink&&i.check(s)){var c=i.resolve(s),p=c.formatted,g=c.formattedHref,v=c.tagName,h=c.className,k=c.target,y=c.attributes,m="<"+v+' href="'+n(g)+'"';h&&(m+=' class="'+n(h)+'"'),k&&(m+=' target="'+n(k)+'"'),y&&(m+=" "+e(y)),m+=">"+r(p)+"</"+v+">",f.push(m)}else f.push(r(s.toString()))}return f.join("")}var o=t.tokenize,a=t.options,u=a.Options;return String.prototype.linkify||(String.prototype.linkify=function(t){return i(this,t)}),i}(r);t.linkifyStr=n}(window,linkify);
|
File diff suppressed because one or more lines are too long
Binary file not shown.
After Width: | Height: | Size: 417 B |
|
@ -0,0 +1,85 @@
|
||||||
|
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
|
||||||
|
<!-- Created with Inkscape (http://www.inkscape.org/) -->
|
||||||
|
|
||||||
|
<svg
|
||||||
|
xmlns:dc="http://purl.org/dc/elements/1.1/"
|
||||||
|
xmlns:cc="http://creativecommons.org/ns#"
|
||||||
|
xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
|
||||||
|
xmlns:svg="http://www.w3.org/2000/svg"
|
||||||
|
xmlns="http://www.w3.org/2000/svg"
|
||||||
|
xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"
|
||||||
|
xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"
|
||||||
|
width="4.5155554mm"
|
||||||
|
height="5.6444445mm"
|
||||||
|
viewBox="0 0 15.999999 20"
|
||||||
|
id="svg2"
|
||||||
|
version="1.1"
|
||||||
|
inkscape:version="0.91 r13725"
|
||||||
|
sodipodi:docname="speechbubble2-l.svg"
|
||||||
|
inkscape:export-filename="/home/tonyg/src/syndicate/examples/webchat/htdocs/speechbubble-l.png"
|
||||||
|
inkscape:export-xdpi="90"
|
||||||
|
inkscape:export-ydpi="90">
|
||||||
|
<defs
|
||||||
|
id="defs4" />
|
||||||
|
<sodipodi:namedview
|
||||||
|
id="base"
|
||||||
|
pagecolor="#ffffff"
|
||||||
|
bordercolor="#666666"
|
||||||
|
borderopacity="1.0"
|
||||||
|
inkscape:pageopacity="0.0"
|
||||||
|
inkscape:pageshadow="2"
|
||||||
|
inkscape:zoom="22.627417"
|
||||||
|
inkscape:cx="2.6426767"
|
||||||
|
inkscape:cy="9.8662922"
|
||||||
|
inkscape:document-units="px"
|
||||||
|
inkscape:current-layer="layer1"
|
||||||
|
showgrid="true"
|
||||||
|
inkscape:window-width="1908"
|
||||||
|
inkscape:window-height="1027"
|
||||||
|
inkscape:window-x="0"
|
||||||
|
inkscape:window-y="28"
|
||||||
|
inkscape:window-maximized="1"
|
||||||
|
inkscape:object-nodes="true"
|
||||||
|
inkscape:snap-bbox="true"
|
||||||
|
inkscape:snap-nodes="false"
|
||||||
|
inkscape:bbox-nodes="true"
|
||||||
|
fit-margin-top="0"
|
||||||
|
fit-margin-left="0"
|
||||||
|
fit-margin-right="0"
|
||||||
|
fit-margin-bottom="0">
|
||||||
|
<inkscape:grid
|
||||||
|
type="xygrid"
|
||||||
|
id="grid4140"
|
||||||
|
originx="0"
|
||||||
|
originy="-4.7244096e-06" />
|
||||||
|
</sodipodi:namedview>
|
||||||
|
<metadata
|
||||||
|
id="metadata7">
|
||||||
|
<rdf:RDF>
|
||||||
|
<cc:Work
|
||||||
|
rdf:about="">
|
||||||
|
<dc:format>image/svg+xml</dc:format>
|
||||||
|
<dc:type
|
||||||
|
rdf:resource="http://purl.org/dc/dcmitype/StillImage" />
|
||||||
|
<dc:title></dc:title>
|
||||||
|
</cc:Work>
|
||||||
|
</rdf:RDF>
|
||||||
|
</metadata>
|
||||||
|
<g
|
||||||
|
inkscape:label="Layer 1"
|
||||||
|
inkscape:groupmode="layer"
|
||||||
|
id="layer1"
|
||||||
|
transform="translate(0,-1032.3622)">
|
||||||
|
<path
|
||||||
|
style="fill:#ffffff;fill-opacity:1;fill-rule:evenodd;stroke:none;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"
|
||||||
|
d="m 16,1032.3622 -16,10 16,10 z"
|
||||||
|
id="path4138"
|
||||||
|
inkscape:connector-curvature="0"
|
||||||
|
sodipodi:nodetypes="cccc" />
|
||||||
|
<path
|
||||||
|
style="fill:none;fill-opacity:1;fill-rule:evenodd;stroke:#d3d3d3;stroke-width:0.99999994px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"
|
||||||
|
d="m 23.500001,1028.2643 -22.556417,14.0979 22.556417,14.098 z"
|
||||||
|
id="path4142"
|
||||||
|
inkscape:connector-curvature="0" />
|
||||||
|
</g>
|
||||||
|
</svg>
|
After Width: | Height: | Size: 2.7 KiB |
Binary file not shown.
After Width: | Height: | Size: 500 B |
|
@ -0,0 +1,85 @@
|
||||||
|
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
|
||||||
|
<!-- Created with Inkscape (http://www.inkscape.org/) -->
|
||||||
|
|
||||||
|
<svg
|
||||||
|
xmlns:dc="http://purl.org/dc/elements/1.1/"
|
||||||
|
xmlns:cc="http://creativecommons.org/ns#"
|
||||||
|
xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
|
||||||
|
xmlns:svg="http://www.w3.org/2000/svg"
|
||||||
|
xmlns="http://www.w3.org/2000/svg"
|
||||||
|
xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"
|
||||||
|
xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"
|
||||||
|
width="4.5155554mm"
|
||||||
|
height="5.6444445mm"
|
||||||
|
viewBox="0 0 15.999999 20"
|
||||||
|
id="svg2"
|
||||||
|
version="1.1"
|
||||||
|
inkscape:version="0.91 r13725"
|
||||||
|
sodipodi:docname="speechbubble2-r.svg"
|
||||||
|
inkscape:export-filename="/home/tonyg/src/syndicate/examples/webchat/htdocs/speechbubble-r.png"
|
||||||
|
inkscape:export-xdpi="90"
|
||||||
|
inkscape:export-ydpi="90">
|
||||||
|
<defs
|
||||||
|
id="defs4" />
|
||||||
|
<sodipodi:namedview
|
||||||
|
id="base"
|
||||||
|
pagecolor="#ffffff"
|
||||||
|
bordercolor="#666666"
|
||||||
|
borderopacity="1.0"
|
||||||
|
inkscape:pageopacity="0.0"
|
||||||
|
inkscape:pageshadow="2"
|
||||||
|
inkscape:zoom="22.627417"
|
||||||
|
inkscape:cx="2.6426767"
|
||||||
|
inkscape:cy="9.8662922"
|
||||||
|
inkscape:document-units="px"
|
||||||
|
inkscape:current-layer="layer1"
|
||||||
|
showgrid="true"
|
||||||
|
inkscape:window-width="1908"
|
||||||
|
inkscape:window-height="1027"
|
||||||
|
inkscape:window-x="0"
|
||||||
|
inkscape:window-y="28"
|
||||||
|
inkscape:window-maximized="1"
|
||||||
|
inkscape:object-nodes="true"
|
||||||
|
inkscape:snap-bbox="true"
|
||||||
|
inkscape:snap-nodes="false"
|
||||||
|
inkscape:bbox-nodes="true"
|
||||||
|
fit-margin-top="0"
|
||||||
|
fit-margin-left="0"
|
||||||
|
fit-margin-right="0"
|
||||||
|
fit-margin-bottom="0">
|
||||||
|
<inkscape:grid
|
||||||
|
type="xygrid"
|
||||||
|
id="grid4140"
|
||||||
|
originx="0"
|
||||||
|
originy="-4.7244096e-06" />
|
||||||
|
</sodipodi:namedview>
|
||||||
|
<metadata
|
||||||
|
id="metadata7">
|
||||||
|
<rdf:RDF>
|
||||||
|
<cc:Work
|
||||||
|
rdf:about="">
|
||||||
|
<dc:format>image/svg+xml</dc:format>
|
||||||
|
<dc:type
|
||||||
|
rdf:resource="http://purl.org/dc/dcmitype/StillImage" />
|
||||||
|
<dc:title></dc:title>
|
||||||
|
</cc:Work>
|
||||||
|
</rdf:RDF>
|
||||||
|
</metadata>
|
||||||
|
<g
|
||||||
|
inkscape:label="Layer 1"
|
||||||
|
inkscape:groupmode="layer"
|
||||||
|
id="layer1"
|
||||||
|
transform="translate(0,-1032.3622)">
|
||||||
|
<path
|
||||||
|
style="fill:#e8e8ff;fill-opacity:1;fill-rule:evenodd;stroke:none;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"
|
||||||
|
d="m 0,1032.3622 16,10 -16,10 z"
|
||||||
|
id="path4138"
|
||||||
|
inkscape:connector-curvature="0"
|
||||||
|
sodipodi:nodetypes="cccc" />
|
||||||
|
<path
|
||||||
|
style="fill:none;fill-opacity:1;fill-rule:evenodd;stroke:#d3d3d3;stroke-width:0.99999994px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"
|
||||||
|
d="m -7.5000015,1028.2643 22.5564175,14.0979 -22.5564175,14.098 z"
|
||||||
|
id="path4142"
|
||||||
|
inkscape:connector-curvature="0" />
|
||||||
|
</g>
|
||||||
|
</svg>
|
After Width: | Height: | Size: 2.7 KiB |
|
@ -0,0 +1,213 @@
|
||||||
|
template {
|
||||||
|
display: none !important;
|
||||||
|
}
|
||||||
|
|
||||||
|
img.avatar {
|
||||||
|
border-radius: 24px;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* --------------------------------------------------------------------------- */
|
||||||
|
|
||||||
|
.main-container {
|
||||||
|
display: flex;
|
||||||
|
height: 100vh;
|
||||||
|
flex-direction: column;
|
||||||
|
}
|
||||||
|
|
||||||
|
#main-div {
|
||||||
|
flex: 1;
|
||||||
|
overflow: auto;
|
||||||
|
}
|
||||||
|
|
||||||
|
.column-container {
|
||||||
|
display: flex;
|
||||||
|
flex-direction: column;
|
||||||
|
}
|
||||||
|
|
||||||
|
.column-fill {
|
||||||
|
flex: 1;
|
||||||
|
overflow: auto;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* --------------------------------------------------------------------------- */
|
||||||
|
|
||||||
|
.alert-count {
|
||||||
|
background: red;
|
||||||
|
color: white;
|
||||||
|
padding: 0em 0.25em;
|
||||||
|
border-radius: 4px;
|
||||||
|
}
|
||||||
|
|
||||||
|
.hide-zero-count.count0 {
|
||||||
|
display: none;
|
||||||
|
}
|
||||||
|
|
||||||
|
.show-only-zero-count {
|
||||||
|
display: none;
|
||||||
|
}
|
||||||
|
.show-only-zero-count.count0 {
|
||||||
|
display: inherit;
|
||||||
|
}
|
||||||
|
|
||||||
|
.plural.count1 {
|
||||||
|
display: none;
|
||||||
|
}
|
||||||
|
|
||||||
|
.contact-list-present-false {
|
||||||
|
opacity: 0.3;
|
||||||
|
}
|
||||||
|
|
||||||
|
.align-right { text-align: right; }
|
||||||
|
.align-center { text-align: center; }
|
||||||
|
|
||||||
|
.cursor-interactive {
|
||||||
|
cursor: pointer;
|
||||||
|
}
|
||||||
|
|
||||||
|
.dropdown-marginal {
|
||||||
|
left: -1.1em;
|
||||||
|
display: inline-block;
|
||||||
|
width: 0px;
|
||||||
|
position: relative;
|
||||||
|
}
|
||||||
|
|
||||||
|
.forcewrap {
|
||||||
|
word-wrap: break-word !important;
|
||||||
|
xhyphens: auto;
|
||||||
|
}
|
||||||
|
|
||||||
|
.big-icon {
|
||||||
|
font-size: 1.75rem;
|
||||||
|
}
|
||||||
|
|
||||||
|
.invited-tick {
|
||||||
|
font-size: 2rem;
|
||||||
|
width: 48px;
|
||||||
|
height: 48px;
|
||||||
|
display: inline-block;
|
||||||
|
border-radius: 24px;
|
||||||
|
color: white;
|
||||||
|
background: darkgreen;
|
||||||
|
text-align: center;
|
||||||
|
line-height: 0px;
|
||||||
|
}
|
||||||
|
|
||||||
|
.invited-tick .icon {
|
||||||
|
position: relative;
|
||||||
|
top: 0.5rem;
|
||||||
|
}
|
||||||
|
|
||||||
|
.blurb-box {
|
||||||
|
}
|
||||||
|
|
||||||
|
.float-right { float: right; }
|
||||||
|
|
||||||
|
.main-container footer {
|
||||||
|
padding-top: 1rem;
|
||||||
|
text-align: right;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* --------------------------------------------------------------------------- */
|
||||||
|
|
||||||
|
.conversation-control-panel {
|
||||||
|
font-size: 2rem;
|
||||||
|
}
|
||||||
|
|
||||||
|
.post-backdrop {
|
||||||
|
overflow-y: scroll;
|
||||||
|
}
|
||||||
|
|
||||||
|
.post {
|
||||||
|
margin: 20px;
|
||||||
|
}
|
||||||
|
|
||||||
|
.post .post-body {
|
||||||
|
background: white;
|
||||||
|
border: solid #d3d3d3 1px;
|
||||||
|
border-radius: 1.5rem;
|
||||||
|
padding: 1rem;
|
||||||
|
margin: 0 0px;
|
||||||
|
min-height: 60px;
|
||||||
|
}
|
||||||
|
|
||||||
|
.post p {
|
||||||
|
margin-bottom: 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
.post.from-me .post-body {
|
||||||
|
background: #e8e8ff;
|
||||||
|
margin-left: 4rem;
|
||||||
|
margin-right: -1px;
|
||||||
|
}
|
||||||
|
|
||||||
|
.post.to-me .post-body {
|
||||||
|
margin-left: -1px;
|
||||||
|
margin-right: 4rem;
|
||||||
|
}
|
||||||
|
|
||||||
|
.post.from-me:after {
|
||||||
|
content: url('/speechbubble-r.png');
|
||||||
|
position: relative;
|
||||||
|
/* left: 100%; */
|
||||||
|
right: -100%;
|
||||||
|
top: -40px;
|
||||||
|
height: 0px;
|
||||||
|
width: 0px;
|
||||||
|
display: block;
|
||||||
|
}
|
||||||
|
|
||||||
|
.post.to-me:after {
|
||||||
|
content: url('/speechbubble-l.png');
|
||||||
|
position: relative;
|
||||||
|
left: -16px;
|
||||||
|
top: -40px;
|
||||||
|
height: 0px;
|
||||||
|
width: 0px;
|
||||||
|
display: block;
|
||||||
|
}
|
||||||
|
|
||||||
|
.post-date {
|
||||||
|
float: right;
|
||||||
|
height: 0.25em;
|
||||||
|
display: block;
|
||||||
|
font-size: 0.75rem;
|
||||||
|
padding-right: 0.5em;
|
||||||
|
}
|
||||||
|
|
||||||
|
.post-author {
|
||||||
|
/* font-weight: bold; */
|
||||||
|
font-size: 0.75rem;
|
||||||
|
position: relative;
|
||||||
|
top: -0.75em;
|
||||||
|
height: 0.75em;
|
||||||
|
}
|
||||||
|
|
||||||
|
.post-item {
|
||||||
|
}
|
||||||
|
|
||||||
|
.post-item-draft {
|
||||||
|
/* background: #e8e8ff; */
|
||||||
|
background: white;
|
||||||
|
border: solid #d3d3d3 1px;
|
||||||
|
border-radius: 1.5rem;
|
||||||
|
padding: 1rem;
|
||||||
|
margin: 1rem 0 0 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
.post-item-draft .close-draft {
|
||||||
|
float: right;
|
||||||
|
}
|
||||||
|
|
||||||
|
.post-item-image {
|
||||||
|
max-width: 100%;
|
||||||
|
max-height: 50vh;
|
||||||
|
}
|
||||||
|
|
||||||
|
.post-item-draft .post-item-image {
|
||||||
|
max-width: 80%;
|
||||||
|
max-height: 30vh;
|
||||||
|
}
|
||||||
|
|
||||||
|
.post-item .post-item-body-container table.application-octet-stream td {
|
||||||
|
text-align: center;
|
||||||
|
}
|
|
@ -0,0 +1,22 @@
|
||||||
|
<div class="col-xs-12 col-md-6 col-lg-4 p-1 dropdown">
|
||||||
|
<div class="cursor-interactive contact-list-present-{{isPresent}} dropdown-toggle" data-toggle="dropdown">
|
||||||
|
<img class="avatar" src="{{avatar}}">
|
||||||
|
<span class="forcewrap">{{email}}</span>
|
||||||
|
{{#pendingContactRequest}}(pending){{/pendingContactRequest}}
|
||||||
|
</div>
|
||||||
|
<div class="dropdown-menu pt-0 w-100">
|
||||||
|
<img src="{{avatar}}&s=512" class="w-100">
|
||||||
|
<div class="my-1 mx-2">
|
||||||
|
<h3 class="forcewrap">{{email}}</h3>
|
||||||
|
<!-- <p> -->
|
||||||
|
<!-- It is a long established fact that a reader will be distracted -->
|
||||||
|
<!-- by the readable content of a page when looking at its layout. -->
|
||||||
|
<!-- </p> -->
|
||||||
|
<!-- <hr> -->
|
||||||
|
<!-- <p>Rest of text.</p> -->
|
||||||
|
</div>
|
||||||
|
<div class="dropdown-divider"></div>
|
||||||
|
{{#pendingContactRequest}}<button class="dropdown-item delete-contact"><i class="dropdown-marginal icon ion-help"></i>Cancel pending contact request</button>{{/pendingContactRequest}}
|
||||||
|
{{^pendingContactRequest}}<button class="dropdown-item delete-contact"><i class="dropdown-marginal icon ion-trash-b"></i>Delete contact</button>{{/pendingContactRequest}}
|
||||||
|
</div>
|
||||||
|
</div>
|
|
@ -0,0 +1,8 @@
|
||||||
|
<div class="card conversation-card">
|
||||||
|
<div class="card-block {{#isSelected}}bg-primary text-white{{/isSelected}}">
|
||||||
|
<div class="card-title">{{title}}{{^title}}<i>Untitled</i>{{/title}}</div>
|
||||||
|
{{#members}}
|
||||||
|
<img src="{{avatar}}">
|
||||||
|
{{/members}}
|
||||||
|
</div>
|
||||||
|
</div>
|
|
@ -0,0 +1,2 @@
|
||||||
|
<li>{{issuer}} {{grantee}} {{permission}} {{isDelegable}}
|
||||||
|
<button class="revoke">Revoke</button></li>
|
|
@ -0,0 +1,7 @@
|
||||||
|
<div class="col-xs-12 col-md-6 col-lg-4 p-1">
|
||||||
|
<div class="cursor-interactive contact-list-present-{{isPresent}} toggle-invitee-status p-2 {{#isInvited}}bg-primary text-white{{/isInvited}} rounded">
|
||||||
|
{{#isInvited}}<span class="invited-tick"><i class="icon ion-checkmark"></i></span>{{/isInvited}}
|
||||||
|
{{^isInvited}}<img class="avatar" src="{{avatar}}">{{/isInvited}}
|
||||||
|
<span class="forcewrap">{{email}}</span>
|
||||||
|
</div>
|
||||||
|
</div>
|
|
@ -0,0 +1,24 @@
|
||||||
|
<li class="nav-item dropdown">
|
||||||
|
<span class="nav-link dropdown-toggle contact-list-present-{{globallyVisible}} cursor-interactive" data-toggle="dropdown" id="nav-account">
|
||||||
|
<img class="avatar" src="{{avatar}}">
|
||||||
|
<span class="alert-count hide-zero-count count{{questionCount}}">{{questionCount}}</span>
|
||||||
|
<span class="forcewrap">{{email}}</span></span>
|
||||||
|
<div class="dropdown-menu dropdown-menu-right" aria-labelledby="nav-account">
|
||||||
|
<button class="dropdown-item toggleInvisible"><i class="icon ion-checkmark dropdown-marginal" {{#locallyVisible}}hidden{{/locallyVisible}}></i>Be invisible</button>
|
||||||
|
<div class="dropdown-divider"></div>
|
||||||
|
<a class="dropdown-item" href="#/conversations">Conversations</a>
|
||||||
|
<div class="dropdown-divider"></div>
|
||||||
|
<a class="dropdown-item" href="#/permissions">Permissions...</a>
|
||||||
|
<div class="dropdown-divider"></div>
|
||||||
|
<a class="dropdown-item" href="#/questions">
|
||||||
|
<span class="alert-count hide-zero-count count{{questionCount}}">{{questionCount}}</span>
|
||||||
|
Question<span class="plural count{{questionCount}}">s</span> waiting for your answer</a>
|
||||||
|
<a class="dropdown-item" href="#/my-requests">
|
||||||
|
<span class="normal-count hide-zero-count count{{myRequestCount}}">{{myRequestCount}}</span>
|
||||||
|
Request<span class="plural count{{myRequestCount}}">s</span> for others to answer</a>
|
||||||
|
<div class="dropdown-divider"></div>
|
||||||
|
<a class="dropdown-item" href="#/contacts">Manage contacts</a>
|
||||||
|
<div class="dropdown-divider"></div>
|
||||||
|
<a class="dropdown-item" href="/logout">Log out</a>
|
||||||
|
</div>
|
||||||
|
</li>
|
|
@ -0,0 +1,11 @@
|
||||||
|
<div class="card col-xs-12 col-lg-6 {{questionClass}}">
|
||||||
|
<div class="card-block">
|
||||||
|
<h4 class="card-title">{{title}}</h4>
|
||||||
|
{{&blurb}}
|
||||||
|
<div class="list-group">
|
||||||
|
{{#options}}
|
||||||
|
<button class="list-group-item list-group-item-action response" data-value="{{0}}">{{1}}</button>
|
||||||
|
{{/options}}
|
||||||
|
</div>
|
||||||
|
</div>
|
||||||
|
</div>
|
|
@ -0,0 +1,11 @@
|
||||||
|
<h2>Add a new contact</h2>
|
||||||
|
<form class="form-inline">
|
||||||
|
<label for="add-contact-email">New contact email: </label>
|
||||||
|
<input class="form-control" id="add-contact-email" type="email">
|
||||||
|
<button class="btn btn-default" id="add-contact">Add contact</button>
|
||||||
|
</form>
|
||||||
|
|
||||||
|
<h2>Contact List</h2>
|
||||||
|
<div class="container">
|
||||||
|
<div class="contact-list" class="row"></div>
|
||||||
|
</div>
|
|
@ -0,0 +1,157 @@
|
||||||
|
<div class="modal fade" id="invitation-modal" tabindex="-1" role="dialog" aria-hidden="true">
|
||||||
|
<div class="modal-dialog" role="document">
|
||||||
|
<form class="modal-content">
|
||||||
|
<div class="modal-header">
|
||||||
|
<button type="button" class="close" data-dismiss="modal" aria-label="Close">
|
||||||
|
<span aria-hidden="true">×</span>
|
||||||
|
</button>
|
||||||
|
<h4 class="modal-title" id="myModalLabel">Invite User</h4>
|
||||||
|
</div>
|
||||||
|
<div class="modal-body">
|
||||||
|
<label for="invited-username">User to invite:</label>
|
||||||
|
<input type="email" class="form-control" id="invited-username" placeholder="username@example.com">
|
||||||
|
</div>
|
||||||
|
<div class="modal-footer">
|
||||||
|
<button type="button" class="btn btn-secondary" data-dismiss="modal">Cancel</button>
|
||||||
|
<button class="btn btn-primary btn-default send-invitation">Invite</button>
|
||||||
|
</div>
|
||||||
|
</form>
|
||||||
|
</div>
|
||||||
|
</div>
|
||||||
|
|
||||||
|
<div class="container h-100">
|
||||||
|
<div class="row h-100">
|
||||||
|
{{#showConversationList}}
|
||||||
|
<div class="col-md-4 h-100 column-container">
|
||||||
|
<div id="conversation-list" class="column-fill">
|
||||||
|
</div>
|
||||||
|
<div class="align-center">
|
||||||
|
<a class="big-icon text-gray-dark" href="#/new-chat"><i class="cursor-interactive icon ion-plus-circled"></i></a>
|
||||||
|
</div>
|
||||||
|
</div>
|
||||||
|
{{/showConversationList}}
|
||||||
|
{{#showConversationMain}}
|
||||||
|
<div id="conversation-main" class="col-md-8 h-100 column-container">
|
||||||
|
{{#selected}}
|
||||||
|
|
||||||
|
<div class="column-fill post-backdrop {{^miniMode}}not-{{/miniMode}}mini-mode">
|
||||||
|
{{#miniMode}}
|
||||||
|
<div class="conversation-control-panel bg-primary text-white px-1 mb-1">
|
||||||
|
<div class="float-right dropdown">
|
||||||
|
<i class="cursor-interactive icon ion-more" data-toggle="dropdown"></i>
|
||||||
|
<div class="dropdown-menu dropdown-menu-right">
|
||||||
|
{{#overflowMenuItems}}
|
||||||
|
{{#separator}}
|
||||||
|
<div class="dropdown-divider"></div>
|
||||||
|
{{/separator}}
|
||||||
|
{{^separator}}
|
||||||
|
<button class="dropdown-item {{action}}">{{label}}</button>
|
||||||
|
{{/separator}}
|
||||||
|
{{/overflowMenuItems}}
|
||||||
|
</div>
|
||||||
|
</div>
|
||||||
|
<i class="toggle-info-mode float-right icon ion-information-circled pr-1"></i>
|
||||||
|
{{#showConversationInfo}}
|
||||||
|
<i class="end-info-mode icon ion-arrow-left-c" style="padding-right: 0.5rem"></i>
|
||||||
|
{{/showConversationInfo}}
|
||||||
|
{{^showConversationInfo}}
|
||||||
|
<a class="text-white" style="padding-right: 0.5rem" href="#/conversations"><i class="icon ion-arrow-left-c"></i></a>
|
||||||
|
{{/showConversationInfo}}
|
||||||
|
<span>{{title}}{{^title}}<i class="text-muted">Untitled</i>{{/title}}</span>
|
||||||
|
</div>
|
||||||
|
{{/miniMode}}
|
||||||
|
|
||||||
|
{{#showConversationInfo}}
|
||||||
|
<div>
|
||||||
|
<div class="float-right dropdown mr-1">
|
||||||
|
<i class="cursor-interactive big-icon icon ion-more" data-toggle="dropdown"></i>
|
||||||
|
<div class="dropdown-menu dropdown-menu-right">
|
||||||
|
{{#overflowMenuItems}}
|
||||||
|
{{^hidden}}
|
||||||
|
{{#separator}}
|
||||||
|
<div class="dropdown-divider"></div>
|
||||||
|
{{/separator}}
|
||||||
|
{{^separator}}
|
||||||
|
<button class="dropdown-item {{action}}">{{label}}</button>
|
||||||
|
{{/separator}}
|
||||||
|
{{/hidden}}
|
||||||
|
{{/overflowMenuItems}}
|
||||||
|
</div>
|
||||||
|
</div>
|
||||||
|
{{#editingTitle}}
|
||||||
|
<h2 class="mr-1">
|
||||||
|
<form class="form-inline">
|
||||||
|
<input type="text" autocomplete="off" class="form-control" id="conversation-title" value="{{title}}">
|
||||||
|
<button class="form-control btn btn-primary btn-default" id="accept-conversation-title"><i class="icon ion-checkmark"></i></button>
|
||||||
|
<button class="form-control btn btn-secondary" id="cancel-edit-conversation-title"><i class="icon ion-close"></i></button>
|
||||||
|
</form>
|
||||||
|
</h2>
|
||||||
|
{{/editingTitle}}
|
||||||
|
{{^editingTitle}}
|
||||||
|
<form class="form-inline float-right">
|
||||||
|
<button class="form-control btn" id="edit-conversation-title"><i class="icon ion-edit"></i></button>
|
||||||
|
</form>
|
||||||
|
<h2 id="title-heading">{{title}}{{^title}}<i class="text-muted">Untitled</i>{{/title}}</h2>
|
||||||
|
{{/editingTitle}}
|
||||||
|
<hr>
|
||||||
|
|
||||||
|
{{#editingBlurb}}
|
||||||
|
<div class="mr-1">
|
||||||
|
<textarea rows="3" class="form-control" id="conversation-blurb">{{blurb}}</textarea>
|
||||||
|
<form class="form-inline align-right pb-1">
|
||||||
|
<button class="form-control btn btn-primary btn-default" id="accept-conversation-blurb"><i class="icon ion-checkmark"></i></button>
|
||||||
|
<button class="form-control btn btn-secondary" id="cancel-edit-conversation-blurb"><i class="icon ion-close"></i></button>
|
||||||
|
</form>
|
||||||
|
</div>
|
||||||
|
{{/editingBlurb}}
|
||||||
|
{{^editingBlurb}}
|
||||||
|
<div>
|
||||||
|
<form class="form-inline float-right">
|
||||||
|
<button class="form-control btn" id="edit-conversation-blurb"><i class="icon ion-edit"></i></button>
|
||||||
|
</form>
|
||||||
|
<div id="blurb" class="blurb-box">
|
||||||
|
{{#blurb}}
|
||||||
|
<p>{{blurb}}</p>
|
||||||
|
{{/blurb}}
|
||||||
|
{{^blurb}}
|
||||||
|
<p><i class="text-muted">Set a conversation topic here</i></p>
|
||||||
|
{{/blurb}}
|
||||||
|
</div>
|
||||||
|
</div>
|
||||||
|
{{/editingBlurb}}
|
||||||
|
</div>
|
||||||
|
{{/showConversationInfo}}
|
||||||
|
|
||||||
|
{{#showConversationPosts}}
|
||||||
|
<div class="posts"></div>
|
||||||
|
{{/showConversationPosts}}
|
||||||
|
</div>
|
||||||
|
{{#showConversationPosts}}
|
||||||
|
<div id="pending-draft-items">
|
||||||
|
</div>
|
||||||
|
<form id="message-input-form" class="form-inline pt-1" style="display: flex;">
|
||||||
|
<input type="text" autocomplete="off" id="message-input" class="form-control" style="flex: 1">
|
||||||
|
<input type="file" style="display: none;" hidden id="attach-item-file">
|
||||||
|
<button type="button" id="attach-item-button" class="form-control btn btn-secondary" style="max-width: 3em; font-size: 120%;"><i class="icon ion-paperclip"></i></button>
|
||||||
|
<button type="submit" id="send-message-button" class="form-control btn btn-primary btn-default" style="max-width: 3em"><i class="icon ion-paper-airplane"></i></button>
|
||||||
|
</form>
|
||||||
|
{{/showConversationPosts}}
|
||||||
|
|
||||||
|
{{/selected}}
|
||||||
|
|
||||||
|
{{^selected}}
|
||||||
|
<p class="align-center">
|
||||||
|
Select a conversation from the column to the left,
|
||||||
|
or <a href="#/new-chat">create a new conversation</a>.
|
||||||
|
</p>
|
||||||
|
{{/selected}}
|
||||||
|
</div>
|
||||||
|
{{/showConversationMain}}
|
||||||
|
</div>
|
||||||
|
</div>
|
||||||
|
{{#miniMode}}
|
||||||
|
<style>
|
||||||
|
footer { display: none; }
|
||||||
|
#message-input-form { margin-bottom: 1rem; }
|
||||||
|
</style>
|
||||||
|
{{/miniMode}}
|
|
@ -0,0 +1,3 @@
|
||||||
|
<h2>Requests I have made</h2>
|
||||||
|
<p class="show-only-zero-count count{{myRequestCount}}">You have no outstanding requests waiting for responses from others.</p>
|
||||||
|
<ul id="my-permission-requests"></ul>
|
|
@ -0,0 +1,35 @@
|
||||||
|
<h2>New Conversation</h2>
|
||||||
|
<hr>
|
||||||
|
|
||||||
|
<h4>Select people to add</h4>
|
||||||
|
<div class="input-group">
|
||||||
|
<input class="form-control"
|
||||||
|
type="search"
|
||||||
|
id="search-contacts"
|
||||||
|
placeholder="Search contacts"
|
||||||
|
value="{{searchString}}">
|
||||||
|
<div class="input-group-addon"><i class="icon ion-search"></i></div>
|
||||||
|
</div>
|
||||||
|
<div class="container">
|
||||||
|
<div class="contact-list" class="row"></div>
|
||||||
|
</div>
|
||||||
|
|
||||||
|
<hr>
|
||||||
|
<h4>Configure the conversation</h4>
|
||||||
|
<form>
|
||||||
|
<div class="form-group">
|
||||||
|
<label for="conversation-title">Conversation Title</label>
|
||||||
|
<input type="text" autocomplete="off" class="form-control" id="conversation-title">
|
||||||
|
</div>
|
||||||
|
<div class="form-group">
|
||||||
|
<label for="conversation-blurb">Conversation Description</label>
|
||||||
|
<textarea class="form-control" id="conversation-blurb" rows="3"></textarea>
|
||||||
|
</div>
|
||||||
|
|
||||||
|
<button type="submit" class="btn btn-success create-conversation {{#noInvitees}}disabled{{/noInvitees}}">Create conversation</button>
|
||||||
|
{{#noInvitees}}
|
||||||
|
<div class="alert alert-danger">
|
||||||
|
You must invite at least one person to the conversation.
|
||||||
|
</div>
|
||||||
|
{{/noInvitees}}
|
||||||
|
</form>
|
|
@ -0,0 +1,5 @@
|
||||||
|
<h2>Permissions I enjoy</h2>
|
||||||
|
<ul id="permissions"></ul>
|
||||||
|
|
||||||
|
<h2>Permissions I have granted to others</h2>
|
||||||
|
<ul id="grants"></ul>
|
|
@ -0,0 +1,23 @@
|
||||||
|
<h2>Questions</h2>
|
||||||
|
<div class="show-only-zero-count count{{questionCount}}">
|
||||||
|
<p>There are no questions waiting for you to answer.</p>
|
||||||
|
<ul>
|
||||||
|
<li><a href="#/conversations">Go to conversation list.</a></li>
|
||||||
|
<li><a href="#/contacts">Go to contacts list.</a></li>
|
||||||
|
</ul>
|
||||||
|
</div>
|
||||||
|
<div class="container">
|
||||||
|
<div id="question-container" class="row"></div>
|
||||||
|
</div>
|
||||||
|
<div class="hide-zero-count count{{otherRequestCount}}">
|
||||||
|
<p>
|
||||||
|
<label for="show-all-requests-from-others">Show all pending requests from others? </label>
|
||||||
|
<input type="checkbox" id="show-all-requests-from-others" {{#showRequestsFromOthers}}checked{{/showRequestsFromOthers}}>
|
||||||
|
</p>
|
||||||
|
{{#showRequestsFromOthers}}
|
||||||
|
<div id="all-requests-from-others-div">
|
||||||
|
<h2>All requests from others</h2>
|
||||||
|
<ul id="others-permission-requests"></ul>
|
||||||
|
</div>
|
||||||
|
{{/showRequestsFromOthers}}
|
||||||
|
</div>
|
|
@ -0,0 +1,2 @@
|
||||||
|
<li>{{issuer}} {{permission}} {{isDelegable}}
|
||||||
|
{{#isRelinquishable}}<button class="relinquish">Relinquish</button>{{/isRelinquishable}}</li>
|
|
@ -0,0 +1,3 @@
|
||||||
|
<li>{{issuer}} {{grantee}} {{permissionJSON}}
|
||||||
|
<a href="" class="btn btn-sm btn-primary grant">Grant</a>
|
||||||
|
<a href="" class="btn btn-sm btn-secondary deny">Deny</a></li>
|
|
@ -0,0 +1,3 @@
|
||||||
|
<li>Request from {{grantee}} to follow {{permission.fields.0}}
|
||||||
|
<a href="" class="btn btn-sm btn-primary grant">Grant</a>
|
||||||
|
<a href="" class="btn btn-sm btn-secondary deny">Deny</a></li>
|
|
@ -0,0 +1 @@
|
||||||
|
<li>q {{issuer}} {{permissionJSON}} <a href="" class="btn btn-sm btn-secondary cancel">Cancel</a></li>
|
|
@ -0,0 +1 @@
|
||||||
|
<li>Request to follow {{issuer}} <a href="" class="btn btn-sm btn-secondary cancel">Cancel</a></li>
|
|
@ -0,0 +1,7 @@
|
||||||
|
<div id="post-{{postId}}" class="post {{#fromMe}}from-me{{/fromMe}}{{^fromMe}}to-me{{/fromMe}}">
|
||||||
|
<div class="post-body {{contentClass}} clearfix">
|
||||||
|
{{^fromMe}}<p class="post-author text-muted">{{author}}</p>{{/fromMe}}
|
||||||
|
<div class="post-item-container"></div>
|
||||||
|
<div class="post-date text-muted">{{time}}</div>
|
||||||
|
</div>
|
||||||
|
</div>
|
|
@ -0,0 +1,8 @@
|
||||||
|
<table class="application-octet-stream">
|
||||||
|
<tr>
|
||||||
|
<td><a href="{{itemURL}}"><img src="/Text-x-generic.svg"></a></td>
|
||||||
|
</tr>
|
||||||
|
<tr>
|
||||||
|
<td>{{item.type}}</td>
|
||||||
|
</tr>
|
||||||
|
</table>
|
|
@ -0,0 +1 @@
|
||||||
|
<img class="post-item-image" src="{{itemURL}}">
|
|
@ -0,0 +1 @@
|
||||||
|
<p>{{item.data}}</p>
|
|
@ -0,0 +1,4 @@
|
||||||
|
<div id="{{itemId}}" class="post-item {{#postInfo.isDraft}}post-item-draft{{/postInfo.isDraft}} {{contentClass}} clearfix">
|
||||||
|
{{#postInfo.isDraft}}<button class="btn close-draft"><i class="icon ion-close"></i></button>{{/postInfo.isDraft}}
|
||||||
|
<div class="post-item-body-container"></div>
|
||||||
|
</div>
|
|
@ -0,0 +1,959 @@
|
||||||
|
(function () {
|
||||||
|
// N.B.: "window.status" is an HTML-defined property, and always a
|
||||||
|
// string, so naming things at "global"-level `status` will not have
|
||||||
|
// the desired effect!
|
||||||
|
assertion type online();
|
||||||
|
assertion type present(email);
|
||||||
|
|
||||||
|
assertion type uiTemplate(name, data) = "ui-template";
|
||||||
|
|
||||||
|
assertion type permitted(issuer, email, permission, isDelegable);
|
||||||
|
assertion type grant(issuer, grantor, grantee, permission, isDelegable);
|
||||||
|
assertion type permissionRequest(issuer, grantee, permission) = "permission-request";
|
||||||
|
|
||||||
|
assertion type conversation(id, title, creator, blurb);
|
||||||
|
assertion type invitation(conversationId, inviter, invitee);
|
||||||
|
assertion type inConversation(conversationId, member) = "in-conversation";
|
||||||
|
assertion type post(id, timestamp, conversationId, author, items);
|
||||||
|
|
||||||
|
message type createResource(description) = "create-resource";
|
||||||
|
message type updateResource(description) = "update-resource";
|
||||||
|
message type deleteResource(description) = "delete-resource";
|
||||||
|
|
||||||
|
assertion type pFollow(email) = "p:follow";
|
||||||
|
// assertion type pInvite(email) = "p:invite";
|
||||||
|
// assertion type pSeePresence(email) = "p:see-presence";
|
||||||
|
|
||||||
|
assertion type contactListEntry(owner, member) = "contact-list-entry";
|
||||||
|
|
||||||
|
assertion type question(id, timestamp, klass, target, title, blurb, type);
|
||||||
|
assertion type answer(id, value);
|
||||||
|
assertion type yesNoQuestion(falseValue, trueValue) = "yes/no-question";
|
||||||
|
assertion type optionQuestion(options) = "option-question";
|
||||||
|
// ^ options = [[Any, Markdown]]
|
||||||
|
assertion type textQuestion(isMultiline) = "text-question";
|
||||||
|
assertion type acknowledgeQuestion() = "acknowledge-question";
|
||||||
|
|
||||||
|
//---------------------------------------------------------------------------
|
||||||
|
// Local assertions and messages
|
||||||
|
|
||||||
|
assertion type selectedCid(cid); // currently-selected conversation ID, or null
|
||||||
|
message type windowWidthChanged(newWidth);
|
||||||
|
|
||||||
|
assertion type draftItem(timestamp, dataURL);
|
||||||
|
message type draftSent();
|
||||||
|
|
||||||
|
//---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
var brokerConnected = Syndicate.Broker.brokerConnected;
|
||||||
|
var brokerConnection = Syndicate.Broker.brokerConnection;
|
||||||
|
var toBroker = Syndicate.Broker.toBroker;
|
||||||
|
var fromBroker = Syndicate.Broker.fromBroker;
|
||||||
|
var forceBrokerDisconnect = Syndicate.Broker.forceBrokerDisconnect;
|
||||||
|
|
||||||
|
///////////////////////////////////////////////////////////////////////////
|
||||||
|
|
||||||
|
function compute_broker_url() {
|
||||||
|
var u = new URL(document.location);
|
||||||
|
u.protocol = (u.protocol === 'http:') ? 'ws:' : 'wss:';
|
||||||
|
u.pathname = '/broker';
|
||||||
|
u.hash = '';
|
||||||
|
return u.toString();
|
||||||
|
}
|
||||||
|
|
||||||
|
var sessionInfo = {}; // filled in by 'load' event handler
|
||||||
|
var brokerUrl = compute_broker_url();
|
||||||
|
|
||||||
|
function outbound(x) {
|
||||||
|
return toBroker(brokerUrl, x);
|
||||||
|
}
|
||||||
|
|
||||||
|
function inbound(x) {
|
||||||
|
return fromBroker(brokerUrl, x);
|
||||||
|
}
|
||||||
|
|
||||||
|
function avatar(email) {
|
||||||
|
return 'https://www.gravatar.com/avatar/' + md5(email.trim().toLowerCase()) + '?s=48&d=retro';
|
||||||
|
}
|
||||||
|
|
||||||
|
///////////////////////////////////////////////////////////////////////////
|
||||||
|
|
||||||
|
document.addEventListener('dragover', function (e) {
|
||||||
|
e.preventDefault(); // make it so drag-and-drop doesn't load the dropped object into the browser
|
||||||
|
});
|
||||||
|
|
||||||
|
window.addEventListener('load', function () {
|
||||||
|
if (document.body.id === 'webchat-main') {
|
||||||
|
$('head meta').each(function (_i, tag) {
|
||||||
|
var itemprop = tag.attributes.itemprop;
|
||||||
|
var prefix = 'webchat-session-';
|
||||||
|
if (itemprop && itemprop.value.startsWith(prefix)) {
|
||||||
|
var key = itemprop.value.substring(prefix.length);
|
||||||
|
var value = tag.attributes.content.value;
|
||||||
|
sessionInfo[key] = value;
|
||||||
|
}
|
||||||
|
});
|
||||||
|
webchat_main();
|
||||||
|
}
|
||||||
|
});
|
||||||
|
|
||||||
|
function webchat_main() {
|
||||||
|
ground dataspace G {
|
||||||
|
Syndicate.UI.spawnUIDriver({
|
||||||
|
defaultLocationHash: '/conversations'
|
||||||
|
});
|
||||||
|
Syndicate.WakeDetector.spawnWakeDetector();
|
||||||
|
Syndicate.Broker.spawnBrokerClientDriver();
|
||||||
|
spawnInputChangeMonitor();
|
||||||
|
|
||||||
|
spawn {
|
||||||
|
this.ui = new Syndicate.UI.Anchor();
|
||||||
|
var mainpage_c = this.ui.context('mainpage');
|
||||||
|
|
||||||
|
field this.connectedTo = null;
|
||||||
|
field this.myRequestCount = 0; // requests *I* have made of others
|
||||||
|
field this.otherRequestCount = 0; // requests *others* have made of me
|
||||||
|
field this.questionCount = 0; // questions from the system
|
||||||
|
field this.globallyVisible = false; // mirrors *other people's experience of us*
|
||||||
|
field this.locallyVisible = true;
|
||||||
|
field this.showRequestsFromOthers = false;
|
||||||
|
field this.miniMode = $(window).width() < 768;
|
||||||
|
|
||||||
|
window.addEventListener('resize', Syndicate.Dataspace.wrap(function () {
|
||||||
|
:: windowWidthChanged($(window).width());
|
||||||
|
}));
|
||||||
|
|
||||||
|
on message windowWidthChanged($newWidth) {
|
||||||
|
this.miniMode = newWidth < 768;
|
||||||
|
}
|
||||||
|
|
||||||
|
assert brokerConnection(brokerUrl);
|
||||||
|
|
||||||
|
on asserted brokerConnected($url) { this.connectedTo = url; }
|
||||||
|
on retracted brokerConnected(_) { this.connectedTo = null; }
|
||||||
|
|
||||||
|
during inbound(online()) {
|
||||||
|
on start { this.globallyVisible = true; }
|
||||||
|
on stop { this.globallyVisible = false; }
|
||||||
|
}
|
||||||
|
|
||||||
|
during inbound(question($qid, _, _, sessionInfo.email, _, _, _)) {
|
||||||
|
on start { this.questionCount++; }
|
||||||
|
on stop { this.questionCount--; }
|
||||||
|
}
|
||||||
|
|
||||||
|
during inbound(permissionRequest($issuer, sessionInfo.email, $permission)) {
|
||||||
|
on start { this.myRequestCount++; }
|
||||||
|
on stop { this.myRequestCount--; }
|
||||||
|
}
|
||||||
|
|
||||||
|
during inbound(uiTemplate("nav-account.html", $entry)) {
|
||||||
|
var c = this.ui.context('nav', 0, 'account');
|
||||||
|
assert outbound(online()) when (this.locallyVisible);
|
||||||
|
assert c.html('#nav-ul', Mustache.render(entry, {
|
||||||
|
email: sessionInfo.email,
|
||||||
|
avatar: avatar(sessionInfo.email),
|
||||||
|
questionCount: this.questionCount,
|
||||||
|
myRequestCount: this.myRequestCount,
|
||||||
|
otherRequestCount: this.otherRequestCount,
|
||||||
|
globallyVisible: this.globallyVisible,
|
||||||
|
locallyVisible: this.locallyVisible
|
||||||
|
}));
|
||||||
|
on message c.event('.toggleInvisible', 'click', _) {
|
||||||
|
this.locallyVisible = !this.locallyVisible;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
during Syndicate.UI.locationHash('/contacts') {
|
||||||
|
during inbound(uiTemplate("page-contacts.html", $mainEntry)) {
|
||||||
|
assert mainpage_c.html('div#main-div', Mustache.render(mainEntry, {}));
|
||||||
|
}
|
||||||
|
|
||||||
|
during inbound(uiTemplate("contact-entry.html", $entry)) {
|
||||||
|
during mainpage_c.fragmentVersion($mainpageVersion) {
|
||||||
|
during inbound(contactListEntry(sessionInfo.email, $contact)) {
|
||||||
|
field this.pendingContactRequest = false;
|
||||||
|
field this.isPresent = false;
|
||||||
|
during inbound(present(contact)) {
|
||||||
|
on start { this.isPresent = true; }
|
||||||
|
on stop { this.isPresent = false; }
|
||||||
|
}
|
||||||
|
during inbound(permissionRequest(contact, sessionInfo.email, pFollow(contact))) {
|
||||||
|
on start { this.pendingContactRequest = true; }
|
||||||
|
on stop { this.pendingContactRequest = false; }
|
||||||
|
}
|
||||||
|
var c = this.ui.context(mainpageVersion, 'all-contacts', contact);
|
||||||
|
assert c.html('.contact-list', Mustache.render(entry, {
|
||||||
|
email: contact,
|
||||||
|
avatar: avatar(contact),
|
||||||
|
pendingContactRequest: this.pendingContactRequest,
|
||||||
|
isPresent: this.isPresent
|
||||||
|
}));
|
||||||
|
on message c.event('.delete-contact', 'click', _) {
|
||||||
|
if (confirm((this.pendingContactRequest
|
||||||
|
? "Cancel contact request to "
|
||||||
|
: "Delete contact ")
|
||||||
|
+ contact + "?")) {
|
||||||
|
:: outbound(deleteResource(permitted(sessionInfo.email,
|
||||||
|
contact,
|
||||||
|
pFollow(sessionInfo.email),
|
||||||
|
false))); // TODO: true too?!
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
during mainpage_c.fragmentVersion($mainpageVersion) {
|
||||||
|
during inputValue('#add-contact-email', $rawContact) {
|
||||||
|
var contact = rawContact && rawContact.trim();
|
||||||
|
if (contact) {
|
||||||
|
on message mainpage_c.event('#add-contact', 'click', _) {
|
||||||
|
:: outbound(createResource(grant(sessionInfo.email,
|
||||||
|
sessionInfo.email,
|
||||||
|
contact,
|
||||||
|
pFollow(sessionInfo.email),
|
||||||
|
false)));
|
||||||
|
$('#add-contact-email').val('');
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
during Syndicate.UI.locationHash('/permissions') {
|
||||||
|
during inbound(uiTemplate("page-permissions.html", $mainEntry)) {
|
||||||
|
assert mainpage_c.html('div#main-div', Mustache.render(mainEntry, {}));
|
||||||
|
}
|
||||||
|
|
||||||
|
during inbound(uiTemplate("permission-entry.html", $entry)) {
|
||||||
|
during mainpage_c.fragmentVersion($mainpageVersion) {
|
||||||
|
during inbound(permitted($i, $e, $p, $d)) {
|
||||||
|
if (i !== sessionInfo.email) {
|
||||||
|
var c = this.ui.context(mainpageVersion, 'permitted', i, e, p, d);
|
||||||
|
assert c.html('#permissions', Mustache.render(entry, {
|
||||||
|
issuer: i,
|
||||||
|
email: e,
|
||||||
|
permission: JSON.stringify(p),
|
||||||
|
isDelegable: d,
|
||||||
|
isRelinquishable: i !== e
|
||||||
|
}));
|
||||||
|
on message c.event('.relinquish', 'click', _) {
|
||||||
|
:: outbound(deleteResource(permitted(i, e, p, d)));
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
during inbound(uiTemplate("grant-entry.html", $entry)) {
|
||||||
|
during mainpage_c.fragmentVersion($mainpageVersion) {
|
||||||
|
during inbound(grant($i, sessionInfo.email, $ge, $p, $d)) {
|
||||||
|
var c = this.ui.context(mainpageVersion, 'granted', i, ge, p, d);
|
||||||
|
assert c.html('#grants', Mustache.render(entry, {
|
||||||
|
issuer: i,
|
||||||
|
grantee: ge,
|
||||||
|
permission: JSON.stringify(p),
|
||||||
|
isDelegable: d
|
||||||
|
}));
|
||||||
|
on message c.event('.revoke', 'click', _) {
|
||||||
|
:: outbound(deleteResource(grant(i, sessionInfo.email, ge, p, d)));
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
during Syndicate.UI.locationHash('/my-requests') {
|
||||||
|
during inbound(uiTemplate("page-my-requests.html", $mainEntry)) {
|
||||||
|
assert mainpage_c.html('div#main-div', Mustache.render(mainEntry, {
|
||||||
|
myRequestCount: this.myRequestCount
|
||||||
|
}));
|
||||||
|
}
|
||||||
|
|
||||||
|
during inbound(permissionRequest($issuer, sessionInfo.email, $permission)) {
|
||||||
|
during inbound(uiTemplate("permission-request-out-GENERIC.html", $genericEntry)) {
|
||||||
|
during mainpage_c.fragmentVersion($mainpageVersion) {
|
||||||
|
var c = this.ui.context(mainpageVersion, 'my-permission-request', issuer, permission);
|
||||||
|
field this.entry = genericEntry;
|
||||||
|
assert c.html('#my-permission-requests', Mustache.render(this.entry, {
|
||||||
|
issuer: issuer,
|
||||||
|
permission: permission,
|
||||||
|
permissionJSON: JSON.stringify(permission)
|
||||||
|
})) when (this.entry);
|
||||||
|
var specificTemplate = "permission-request-out-" +
|
||||||
|
encodeURIComponent(permission.meta.label) + ".html";
|
||||||
|
on asserted inbound(uiTemplate(specificTemplate, $specificEntry)) {
|
||||||
|
this.entry = specificEntry || genericEntry;
|
||||||
|
}
|
||||||
|
on message c.event('.cancel', 'click', _) {
|
||||||
|
:: outbound(deleteResource(permissionRequest(issuer, sessionInfo.email, permission)));
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
during Syndicate.UI.locationHash('/questions') {
|
||||||
|
during inbound(uiTemplate("page-questions.html", $mainEntry)) {
|
||||||
|
assert mainpage_c.html('div#main-div', Mustache.render(mainEntry, {
|
||||||
|
questionCount: this.questionCount,
|
||||||
|
otherRequestCount: this.otherRequestCount,
|
||||||
|
showRequestsFromOthers: this.showRequestsFromOthers
|
||||||
|
}));
|
||||||
|
}
|
||||||
|
|
||||||
|
during mainpage_c.fragmentVersion($mainpageVersion) {
|
||||||
|
during inputValue('#show-all-requests-from-others', $showRequestsFromOthers) {
|
||||||
|
on start { this.showRequestsFromOthers = showRequestsFromOthers; }
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
during inbound(uiTemplate("permission-request-in-GENERIC.html", $genericEntry)) {
|
||||||
|
during mainpage_c.fragmentVersion($mainpageVersion) {
|
||||||
|
during inbound(permissionRequest($issuer, $grantee, $permission)) {
|
||||||
|
if (grantee !== sessionInfo.email) {
|
||||||
|
on start { this.otherRequestCount++; }
|
||||||
|
on stop { this.otherRequestCount--; }
|
||||||
|
|
||||||
|
var c = this.ui.context(mainpageVersion, 'others-permission-request', issuer, grantee, permission);
|
||||||
|
field this.entry = genericEntry;
|
||||||
|
assert c.html('#others-permission-requests', Mustache.render(this.entry, {
|
||||||
|
issuer: issuer,
|
||||||
|
grantee: grantee,
|
||||||
|
permission: permission,
|
||||||
|
permissionJSON: JSON.stringify(permission)
|
||||||
|
})) when (this.entry);
|
||||||
|
var specificTemplate = "permission-request-in-" +
|
||||||
|
encodeURIComponent(permission.meta.label) + ".html";
|
||||||
|
on asserted inbound(uiTemplate(specificTemplate, $specificEntry)) {
|
||||||
|
this.entry = specificEntry || genericEntry;
|
||||||
|
}
|
||||||
|
on message c.event('.grant', 'click', _) {
|
||||||
|
:: outbound(createResource(grant(issuer,
|
||||||
|
sessionInfo.email,
|
||||||
|
grantee,
|
||||||
|
permission,
|
||||||
|
false)));
|
||||||
|
}
|
||||||
|
on message c.event('.deny', 'click', _) {
|
||||||
|
:: outbound(deleteResource(permissionRequest(issuer, grantee, permission)));
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
during inbound(question($qid, $timestamp, $klass, sessionInfo.email, $title, $blurb, $qt))
|
||||||
|
{
|
||||||
|
during mainpage_c.fragmentVersion($mainpageVersion) {
|
||||||
|
var c = this.ui.context(mainpageVersion, 'question', timestamp, qid);
|
||||||
|
|
||||||
|
switch (qt.meta.label) {
|
||||||
|
case "option-question": {
|
||||||
|
var options = qt.fields[0];
|
||||||
|
during inbound(uiTemplate("option-question.html", $entry)) {
|
||||||
|
assert c.html('#question-container', Mustache.render(entry, {
|
||||||
|
questionClass: klass,
|
||||||
|
title: title,
|
||||||
|
blurb: blurb,
|
||||||
|
options: options
|
||||||
|
}));
|
||||||
|
on message c.event('.response', 'click', $e) {
|
||||||
|
react { assert outbound(answer(qid, e.target.dataset.value)); }
|
||||||
|
}
|
||||||
|
}
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
default: {
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
var conversations_re = /^\/conversations(\/(.*))?/;
|
||||||
|
during Syndicate.UI.locationHash($locationHash) {
|
||||||
|
var m = locationHash.match(conversations_re);
|
||||||
|
if (m) {
|
||||||
|
assert selectedCid(m[2] || false);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
during inbound(uiTemplate("page-conversations.html", $mainEntry)) {
|
||||||
|
during selectedCid(false) {
|
||||||
|
assert mainpage_c.html('div#main-div', Mustache.render(mainEntry, {
|
||||||
|
miniMode: this.miniMode,
|
||||||
|
showConversationList: true,
|
||||||
|
showConversationMain: !this.miniMode,
|
||||||
|
showConversationInfo: false,
|
||||||
|
showConversationPosts: false,
|
||||||
|
selected: false
|
||||||
|
}));
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
// Move to the conversation index page when we leave a
|
||||||
|
// conversation (which also happens automatically when it is
|
||||||
|
// deleted)
|
||||||
|
during selectedCid($selected) {
|
||||||
|
on retracted inbound(inConversation(selected, sessionInfo.email)) {
|
||||||
|
:: Syndicate.UI.setLocationHash('/conversations');
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
during inbound(inConversation($cid, sessionInfo.email)) {
|
||||||
|
field this.members = Immutable.Set();
|
||||||
|
field this.title = '';
|
||||||
|
field this.creator = '';
|
||||||
|
field this.blurb = '';
|
||||||
|
field this.editingTitle = false;
|
||||||
|
field this.editingBlurb = false;
|
||||||
|
|
||||||
|
field this.membersJSON = [];
|
||||||
|
dataflow {
|
||||||
|
this.membersJSON = this.members.map(function (m) { return {
|
||||||
|
email: m,
|
||||||
|
avatar: avatar(m)
|
||||||
|
}; }).toArray();
|
||||||
|
}
|
||||||
|
|
||||||
|
on asserted inbound(inConversation(cid, $who)) {
|
||||||
|
this.members = this.members.add(who);
|
||||||
|
}
|
||||||
|
on retracted inbound(inConversation(cid, $who)) {
|
||||||
|
this.members = this.members.remove(who);
|
||||||
|
}
|
||||||
|
|
||||||
|
on asserted inbound(conversation(cid, $title, $creator, $blurb)) {
|
||||||
|
this.title = title;
|
||||||
|
this.creator = creator;
|
||||||
|
this.blurb = blurb;
|
||||||
|
}
|
||||||
|
|
||||||
|
during inbound(uiTemplate("page-conversations.html", $mainEntry)) {
|
||||||
|
during selectedCid($selected) {
|
||||||
|
if (selected === cid) {
|
||||||
|
field this.showInfoMode = false;
|
||||||
|
field this.latestPostTimestamp = 0;
|
||||||
|
field this.latestPostId = null;
|
||||||
|
|
||||||
|
field this.draftItems = Immutable.Map();
|
||||||
|
on asserted draftItem($ts, $d) { this.draftItems = this.draftItems.set(ts, d); }
|
||||||
|
on retracted draftItem($ts, _) { this.draftItems = this.draftItems.remove(ts); }
|
||||||
|
|
||||||
|
assert mainpage_c.html('div#main-div', Mustache.render(mainEntry, {
|
||||||
|
miniMode: this.miniMode,
|
||||||
|
showConversationList: !this.miniMode,
|
||||||
|
showConversationMain: true,
|
||||||
|
showConversationInfo: !this.miniMode || this.showInfoMode,
|
||||||
|
showConversationPosts: !this.miniMode || !this.showInfoMode,
|
||||||
|
selected: selected,
|
||||||
|
title: this.title,
|
||||||
|
blurb: this.blurb,
|
||||||
|
members: this.membersJSON,
|
||||||
|
editingTitle: this.editingTitle,
|
||||||
|
editingBlurb: this.editingBlurb,
|
||||||
|
overflowMenuItems: [
|
||||||
|
{label: "Invite user...", action: "invite-to-conversation"},
|
||||||
|
{label: "Leave conversation", action: "leave-conversation"},
|
||||||
|
{separator: true,
|
||||||
|
hidden: sessionInfo.email !== this.creator},
|
||||||
|
{label: "Delete conversation", action: "delete-conversation",
|
||||||
|
hidden: sessionInfo.email !== this.creator}
|
||||||
|
]
|
||||||
|
}));
|
||||||
|
|
||||||
|
on message mainpage_c.event('#message-input', 'focus', $e) {
|
||||||
|
setTimeout(function () { e.target.scrollIntoView(false); }, 500);
|
||||||
|
}
|
||||||
|
|
||||||
|
var spawnItemFromDataURL = (function (ui) {
|
||||||
|
return function (dataURL) {
|
||||||
|
var timestamp = +(new Date());
|
||||||
|
spawn {
|
||||||
|
field this.ui = ui.context('draft-post', timestamp);
|
||||||
|
assert draftItem(timestamp, dataURL);
|
||||||
|
manifestPostItem(this.ui,
|
||||||
|
'#pending-draft-items',
|
||||||
|
{
|
||||||
|
isDraft: true,
|
||||||
|
postId: 'draft',
|
||||||
|
timestamp: timestamp,
|
||||||
|
fromMe: true,
|
||||||
|
author: sessionInfo.email
|
||||||
|
},
|
||||||
|
dataURL);
|
||||||
|
stop on message draftSent();
|
||||||
|
stop on message this.ui.event('.close-draft', 'click', _);
|
||||||
|
}
|
||||||
|
};
|
||||||
|
})(this.ui);
|
||||||
|
|
||||||
|
var handleDataTransfer = function (dataTransfer) {
|
||||||
|
return dataTransferFiles(dataTransfer, Syndicate.Dataspace.wrap(
|
||||||
|
function (dataURLs) {
|
||||||
|
dataURLs.forEach(spawnItemFromDataURL);
|
||||||
|
}));
|
||||||
|
};
|
||||||
|
|
||||||
|
on message mainpage_c.event('#conversation-main', 'drop', $e) {
|
||||||
|
handleDataTransfer.call(this, e.dataTransfer);
|
||||||
|
}
|
||||||
|
|
||||||
|
on message mainpage_c.event('#message-input', '+paste', $e) {
|
||||||
|
if (handleDataTransfer.call(this, e.clipboardData)) {
|
||||||
|
e.preventDefault();
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
on message mainpage_c.event('#attach-item-button', 'click', _) {
|
||||||
|
console.log('clickenating');
|
||||||
|
$('#attach-item-file').click();
|
||||||
|
}
|
||||||
|
on message mainpage_c.event('#attach-item-file', 'change', $e) {
|
||||||
|
if (e.target.files) {
|
||||||
|
for (var i = 0; i < e.target.files.length; i++) {
|
||||||
|
var file = e.target.files[i];
|
||||||
|
var reader = new FileReader();
|
||||||
|
reader.addEventListener('load', Syndicate.Dataspace.wrap(function (e) {
|
||||||
|
spawnItemFromDataURL(e.target.result);
|
||||||
|
}));
|
||||||
|
reader.readAsDataURL(file);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
on message mainpage_c.event('#send-message-button', 'click', _) {
|
||||||
|
var timestamp = +(new Date());
|
||||||
|
var items = this.draftItems.entrySeq().toArray();
|
||||||
|
items.sort(function (a, b) { return a[0] - b[0]; });
|
||||||
|
var message = ($("#message-input").val() || '').trim();
|
||||||
|
if (message) {
|
||||||
|
var b64 = btoa(unescape(encodeURIComponent(message))); // utf-8, then base64
|
||||||
|
items.push([timestamp,
|
||||||
|
"data:text/plain;charset=utf-8;base64," + encodeURIComponent(b64)]);
|
||||||
|
}
|
||||||
|
if (items.length) {
|
||||||
|
:: outbound(createResource(post(random_hex_string(16),
|
||||||
|
timestamp,
|
||||||
|
cid,
|
||||||
|
sessionInfo.email,
|
||||||
|
items.map(function (di) { return di[1]; }))));
|
||||||
|
}
|
||||||
|
$("#message-input").val('').focus();
|
||||||
|
:: draftSent();
|
||||||
|
}
|
||||||
|
|
||||||
|
on message mainpage_c.event('.invite-to-conversation', 'click', _) {
|
||||||
|
$('#invitation-modal').modal({});
|
||||||
|
}
|
||||||
|
|
||||||
|
on message mainpage_c.event('.send-invitation', 'click', _) {
|
||||||
|
var invitee = $('#invited-username').val().trim();
|
||||||
|
if (invitee) {
|
||||||
|
:: outbound(createResource(invitation(cid, sessionInfo.email, invitee)));
|
||||||
|
$('#invited-username').val('');
|
||||||
|
$('#invitation-modal').modal('hide');
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
on message mainpage_c.event('.leave-conversation', 'click', _) {
|
||||||
|
:: outbound(deleteResource(inConversation(cid, sessionInfo.email)));
|
||||||
|
}
|
||||||
|
|
||||||
|
on message mainpage_c.event('.delete-conversation', 'click', _) {
|
||||||
|
if (confirm("Delete this conversation?")) {
|
||||||
|
:: outbound(deleteResource(conversation(cid,
|
||||||
|
this.title,
|
||||||
|
this.creator,
|
||||||
|
this.blurb)));
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
on message mainpage_c.event('.toggle-info-mode', 'click', _) {
|
||||||
|
this.showInfoMode = !this.showInfoMode;
|
||||||
|
}
|
||||||
|
on message mainpage_c.event('.end-info-mode', 'click', _) {
|
||||||
|
this.showInfoMode = false;
|
||||||
|
}
|
||||||
|
|
||||||
|
on message mainpage_c.event('#edit-conversation-title', 'click', _) {
|
||||||
|
this.editingTitle = true;
|
||||||
|
}
|
||||||
|
on message mainpage_c.event('#title-heading', 'dblclick', _) {
|
||||||
|
this.editingTitle = true;
|
||||||
|
}
|
||||||
|
on message mainpage_c.event('#accept-conversation-title', 'click', _) {
|
||||||
|
this.title = $('#conversation-title').val();
|
||||||
|
:: outbound(updateResource(conversation(cid,
|
||||||
|
this.title,
|
||||||
|
this.creator,
|
||||||
|
this.blurb)));
|
||||||
|
this.editingTitle = false;
|
||||||
|
}
|
||||||
|
on message mainpage_c.event('#cancel-edit-conversation-title', 'click', _) {
|
||||||
|
this.editingTitle = false;
|
||||||
|
}
|
||||||
|
|
||||||
|
on message mainpage_c.event('#edit-conversation-blurb', 'click', _) {
|
||||||
|
this.editingBlurb = true;
|
||||||
|
}
|
||||||
|
on message mainpage_c.event('#blurb', 'dblclick', _) {
|
||||||
|
this.editingBlurb = true;
|
||||||
|
}
|
||||||
|
on message mainpage_c.event('#accept-conversation-blurb', 'click', _) {
|
||||||
|
this.blurb = $('#conversation-blurb').val();
|
||||||
|
:: outbound(updateResource(conversation(cid,
|
||||||
|
this.title,
|
||||||
|
this.creator,
|
||||||
|
this.blurb)));
|
||||||
|
this.editingBlurb = false;
|
||||||
|
}
|
||||||
|
on message mainpage_c.event('#cancel-edit-conversation-blurb', 'click', _) {
|
||||||
|
this.editingBlurb = false;
|
||||||
|
}
|
||||||
|
|
||||||
|
during mainpage_c.fragmentVersion($mainpageVersion) {
|
||||||
|
during inbound(post($pid, $timestamp, cid, $author, $items)) {
|
||||||
|
var fromMe = (author === sessionInfo.email);
|
||||||
|
var postInfo = {
|
||||||
|
isDraft: false,
|
||||||
|
postId: pid,
|
||||||
|
timestamp: timestamp,
|
||||||
|
date: new Date(timestamp).toString(),
|
||||||
|
time: new Date(timestamp).toTimeString().substr(0, 8),
|
||||||
|
fromMe: fromMe,
|
||||||
|
author: author
|
||||||
|
};
|
||||||
|
if (timestamp > this.latestPostTimestamp) {
|
||||||
|
this.latestPostTimestamp = timestamp;
|
||||||
|
this.latestPostId = pid;
|
||||||
|
}
|
||||||
|
var c = this.ui.context(mainpageVersion, 'post', timestamp, pid);
|
||||||
|
during inbound(uiTemplate("post-entry.html", $postEntryTemplate)) {
|
||||||
|
assert c.html('.posts', Mustache.render(postEntryTemplate, postInfo));
|
||||||
|
during c.fragmentVersion($postEntryVersion) {
|
||||||
|
var itemCounter = 0;
|
||||||
|
items.forEach((function (itemURL) {
|
||||||
|
manifestPostItem(c.context('item', postEntryVersion, itemCounter++),
|
||||||
|
'#post-' + pid + ' .post-item-container',
|
||||||
|
postInfo,
|
||||||
|
itemURL);
|
||||||
|
}).bind(this));
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
during inbound(uiTemplate("conversation-index-entry.html", $indexEntry)) {
|
||||||
|
during mainpage_c.fragmentVersion($mainpageVersion) {
|
||||||
|
var c = this.ui.context(mainpageVersion, 'conversationIndex', cid);
|
||||||
|
assert c.html('#conversation-list', Mustache.render(indexEntry, {
|
||||||
|
isSelected: selected === cid,
|
||||||
|
selected: selected,
|
||||||
|
cid: cid,
|
||||||
|
title: this.title,
|
||||||
|
creator: this.creator,
|
||||||
|
members: this.membersJSON
|
||||||
|
}));
|
||||||
|
on message c.event('.card-block', 'click', _) {
|
||||||
|
if (selected === cid) {
|
||||||
|
:: Syndicate.UI.setLocationHash('/conversations');
|
||||||
|
} else {
|
||||||
|
:: Syndicate.UI.setLocationHash('/conversations/' + cid);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
during Syndicate.UI.locationHash('/new-chat') {
|
||||||
|
field this.invitees = Immutable.Set();
|
||||||
|
field this.searchString = '';
|
||||||
|
field this.displayedSearchString = ''; // avoid resetting HTML every keystroke. YUCK
|
||||||
|
|
||||||
|
during inbound(uiTemplate("page-new-chat.html", $mainEntry)) {
|
||||||
|
assert mainpage_c.html('div#main-div', Mustache.render(mainEntry, {
|
||||||
|
noInvitees: this.invitees.isEmpty(),
|
||||||
|
searchString: this.displayedSearchString
|
||||||
|
}));
|
||||||
|
}
|
||||||
|
|
||||||
|
during mainpage_c.fragmentVersion($mainpageVersion) {
|
||||||
|
on message Syndicate.UI.globalEvent('#search-contacts', 'keyup', $e) {
|
||||||
|
this.searchString = e.target.value.trim();
|
||||||
|
}
|
||||||
|
|
||||||
|
on message mainpage_c.event('.create-conversation', 'click', _) {
|
||||||
|
if (!this.invitees.isEmpty()) {
|
||||||
|
var title = $('#conversation-title').val();
|
||||||
|
var blurb = $('#conversation-blurb').val();
|
||||||
|
var cid = random_hex_string(32);
|
||||||
|
:: outbound(createResource(conversation(cid, title, sessionInfo.email, blurb)));
|
||||||
|
:: outbound(createResource(inConversation(cid, sessionInfo.email)));
|
||||||
|
this.invitees.forEach(function (invitee) {
|
||||||
|
:: outbound(createResource(invitation(cid, sessionInfo.email, invitee)));
|
||||||
|
});
|
||||||
|
:: Syndicate.UI.setLocationHash('/conversations/' + cid);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
during inbound(uiTemplate("invitee-entry.html", $entry)) {
|
||||||
|
during mainpage_c.fragmentVersion($mainpageVersion) {
|
||||||
|
during inbound(contactListEntry(sessionInfo.email, $contact)) {
|
||||||
|
field this.isPresent = false;
|
||||||
|
field this.isInvited = false;
|
||||||
|
dataflow {
|
||||||
|
this.isInvited = this.invitees.contains(contact);
|
||||||
|
}
|
||||||
|
during inbound(present(contact)) {
|
||||||
|
on start { this.isPresent = true; }
|
||||||
|
on stop { this.isPresent = false; }
|
||||||
|
}
|
||||||
|
var c = this.ui.context(mainpageVersion, 'all-contacts', contact);
|
||||||
|
assert c.html('.contact-list', Mustache.render(entry, {
|
||||||
|
email: contact,
|
||||||
|
avatar: avatar(contact),
|
||||||
|
isPresent: this.isPresent,
|
||||||
|
isInvited: this.isInvited
|
||||||
|
})) when (this.isInvited ||
|
||||||
|
!this.searchString ||
|
||||||
|
contact.indexOf(this.searchString) !== -1);
|
||||||
|
on message c.event('.toggle-invitee-status', 'click', _) {
|
||||||
|
if (this.invitees.contains(contact)) {
|
||||||
|
this.invitees = this.invitees.remove(contact);
|
||||||
|
} else {
|
||||||
|
this.invitees = this.invitees.add(contact);
|
||||||
|
}
|
||||||
|
this.displayedSearchString = this.searchString;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
// G.dataspace.setOnStateChange(function (mux, patch) {
|
||||||
|
// $("#debug-space").text(Syndicate.prettyTrie(mux.routingTable));
|
||||||
|
// });
|
||||||
|
}
|
||||||
|
|
||||||
|
var nextItemid = 0;
|
||||||
|
function manifestPostItem(uiContext, containerSelector, postInfo, itemURL) {
|
||||||
|
function cleanContentType(t) {
|
||||||
|
t = t.toLowerCase();
|
||||||
|
if (t.startsWith('image/')) {
|
||||||
|
t = 'image';
|
||||||
|
} else {
|
||||||
|
t = t.replace('/', '-');
|
||||||
|
}
|
||||||
|
return t;
|
||||||
|
}
|
||||||
|
|
||||||
|
var item = parseDataURL(itemURL);
|
||||||
|
var itemId = 'post-' + postInfo.postId + '-item-' + nextItemid++;
|
||||||
|
var contentClass = cleanContentType(item.type);
|
||||||
|
var itemInfo = {
|
||||||
|
itemId: itemId,
|
||||||
|
postInfo: postInfo,
|
||||||
|
contentClass: contentClass,
|
||||||
|
item: item,
|
||||||
|
itemURL: itemURL
|
||||||
|
};
|
||||||
|
|
||||||
|
during inbound(uiTemplate("post-item.html", $postItemTemplate)) {
|
||||||
|
field this.entry = false;
|
||||||
|
on asserted inbound(uiTemplate("post-item-" + contentClass + ".html", $entry)) {
|
||||||
|
if (entry) this.entry = entry;
|
||||||
|
}
|
||||||
|
on asserted inbound(uiTemplate("post-item-application-octet-stream.html", $entry)) {
|
||||||
|
if (entry && !this.entry) this.entry = entry;
|
||||||
|
}
|
||||||
|
assert uiContext.html(containerSelector, Mustache.render(postItemTemplate, itemInfo));
|
||||||
|
on asserted uiContext.fragmentVersion($postItemVersion) {
|
||||||
|
var innerContext = uiContext.context('item-body', postItemVersion);
|
||||||
|
assert innerContext.html('#' + itemId + ' .post-item-body-container',
|
||||||
|
Mustache.render(this.entry, itemInfo)) when (this.entry);
|
||||||
|
if (!postInfo.isDraft) {
|
||||||
|
on asserted innerContext.fragmentVersion($innerContextVersion) {
|
||||||
|
if ((this.latestPostTimestamp === postInfo.timestamp) &&
|
||||||
|
(this.latestPostId === postInfo.postId)) {
|
||||||
|
setTimeout(function () { $("#post-" + postInfo.postId)[0].scrollIntoView(false); }, 1);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
})();
|
||||||
|
|
||||||
|
///////////////////////////////////////////////////////////////////////////
|
||||||
|
// Input control value monitoring
|
||||||
|
|
||||||
|
assertion type inputValue(selector, value);
|
||||||
|
|
||||||
|
function spawnInputChangeMonitor() {
|
||||||
|
function valOf(e) {
|
||||||
|
return e ? (e.type === 'checkbox' ? e.checked : e.value) : null;
|
||||||
|
}
|
||||||
|
|
||||||
|
spawn {
|
||||||
|
during Syndicate.observe(inputValue($selector, _)) spawn {
|
||||||
|
field this.value = valOf($(selector)[0]);
|
||||||
|
assert inputValue(selector, this.value);
|
||||||
|
on message Syndicate.UI.globalEvent(selector, 'change', $e) {
|
||||||
|
this.value = valOf(e.target);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
///////////////////////////////////////////////////////////////////////////
|
||||||
|
|
||||||
|
function random_hex_string(halfLength) {
|
||||||
|
var bs = new Uint8Array(halfLength);
|
||||||
|
var encoded = [];
|
||||||
|
crypto.getRandomValues(bs);
|
||||||
|
for (var i = 0; i < bs.length; i++) {
|
||||||
|
encoded.push("0123456789abcdef"[(bs[i] >> 4) & 15]);
|
||||||
|
encoded.push("0123456789abcdef"[bs[i] & 15]);
|
||||||
|
}
|
||||||
|
return encoded.join('');
|
||||||
|
}
|
||||||
|
|
||||||
|
///////////////////////////////////////////////////////////////////////////
|
||||||
|
|
||||||
|
function parseDataURL(u) {
|
||||||
|
var pieces;
|
||||||
|
|
||||||
|
if (!u.startsWith('data:')) return null;
|
||||||
|
u = u.substr(5);
|
||||||
|
|
||||||
|
pieces = u.split(',');
|
||||||
|
if (pieces.length !== 2) return null;
|
||||||
|
|
||||||
|
var mimeType = pieces[0];
|
||||||
|
var data = decodeURIComponent(pieces[1]);
|
||||||
|
var isBase64 = false;
|
||||||
|
|
||||||
|
if (mimeType.endsWith(';base64')) {
|
||||||
|
mimeType = mimeType.substr(0, mimeType.length - 7);
|
||||||
|
isBase64 = true;
|
||||||
|
}
|
||||||
|
|
||||||
|
if (isBase64) {
|
||||||
|
data = atob(data);
|
||||||
|
}
|
||||||
|
|
||||||
|
pieces = mimeType.split(';');
|
||||||
|
var type = pieces[0];
|
||||||
|
|
||||||
|
var parameters = {};
|
||||||
|
for (var i = 1; i < pieces.length; i++) {
|
||||||
|
var m = pieces[i].match(/^([^=]+)=(.*)$/);
|
||||||
|
if (m) {
|
||||||
|
parameters[m[1].toLowerCase()] = m[2];
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
if (type.startsWith('text/')) {
|
||||||
|
var charset = (parameters.charset || 'US-ASCII').toLowerCase();
|
||||||
|
switch (charset) {
|
||||||
|
case 'utf-8':
|
||||||
|
data = decodeURIComponent(escape(data));
|
||||||
|
break;
|
||||||
|
case 'us-ascii':
|
||||||
|
case 'ascii':
|
||||||
|
case 'latin1':
|
||||||
|
case 'iso-8859-1':
|
||||||
|
break;
|
||||||
|
default:
|
||||||
|
console.warn('Unknown charset while decoding data URL:', charset);
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
return {
|
||||||
|
type: type,
|
||||||
|
parameters: parameters,
|
||||||
|
data: data
|
||||||
|
};
|
||||||
|
}
|
||||||
|
|
||||||
|
///////////////////////////////////////////////////////////////////////////
|
||||||
|
|
||||||
|
// Extract file contents from a DataTransfer object
|
||||||
|
function dataTransferFiles(d, k) {
|
||||||
|
var items = d.items;
|
||||||
|
var types = d.types;
|
||||||
|
var files = d.files;
|
||||||
|
|
||||||
|
var results = [];
|
||||||
|
var expectedCount = files.length;
|
||||||
|
var completedCount = 0;
|
||||||
|
|
||||||
|
function completeOne() {
|
||||||
|
completedCount++;
|
||||||
|
if (completedCount === expectedCount) {
|
||||||
|
k(results);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
for (var i = 0; i < items.length; i++) {
|
||||||
|
(function (i) {
|
||||||
|
var item = items[i];
|
||||||
|
var type = types[i];
|
||||||
|
if (type === 'text/uri-list') {
|
||||||
|
expectedCount++;
|
||||||
|
item.getAsString(function (itemstr) {
|
||||||
|
var firstChunk = itemstr.substr(0, 6).toLowerCase();
|
||||||
|
if (firstChunk.startsWith('http:') || firstChunk.startsWith('https:')) {
|
||||||
|
$.ajax({
|
||||||
|
type: "GET",
|
||||||
|
url: itemstr,
|
||||||
|
beforeSend: function (xhr) {
|
||||||
|
xhr.overrideMimeType('text/plain; charset=x-user-defined');
|
||||||
|
},
|
||||||
|
success: function (_data, _status, xhr) {
|
||||||
|
var contentType = xhr.getResponseHeader('content-type');
|
||||||
|
var rawdata = xhr.responseText;
|
||||||
|
var data = [];
|
||||||
|
for (var j = 0; j < rawdata.length; j++) {
|
||||||
|
data = data + String.fromCharCode(rawdata.charCodeAt(j) & 0xff);
|
||||||
|
}
|
||||||
|
results.push('data:' + contentType + ';base64,' + encodeURIComponent(btoa(data)));
|
||||||
|
completeOne();
|
||||||
|
},
|
||||||
|
error: function () {
|
||||||
|
completeOne();
|
||||||
|
}
|
||||||
|
});
|
||||||
|
} else {
|
||||||
|
completeOne();
|
||||||
|
}
|
||||||
|
});
|
||||||
|
}
|
||||||
|
})(i);
|
||||||
|
}
|
||||||
|
|
||||||
|
for (var i = 0; i < files.length; i++) {
|
||||||
|
(function (i) {
|
||||||
|
var file = files[i];
|
||||||
|
var reader = new FileReader();
|
||||||
|
reader.addEventListener('load', function (e) {
|
||||||
|
results.push(e.target.result);
|
||||||
|
completeOne();
|
||||||
|
});
|
||||||
|
reader.readAsDataURL(file);
|
||||||
|
})(i);
|
||||||
|
}
|
||||||
|
|
||||||
|
return (expectedCount > 0);
|
||||||
|
}
|
|
@ -0,0 +1,2 @@
|
||||||
|
testing.rktd
|
||||||
|
compiled/main_rkt.*
|
|
@ -0,0 +1,36 @@
|
||||||
|
✓ Remove delete-account, use delete-resource of an account instead
|
||||||
|
|
||||||
|
✓ Reimplement spawn-session-monitor and end-session to work in terms
|
||||||
|
of create-resource and delete-resource, but leave login-link
|
||||||
|
idiosyncratic
|
||||||
|
|
||||||
|
Factor out resource management into its own module. Introduce a macro
|
||||||
|
for describing resources, their cascading deletion conditions, and
|
||||||
|
their potential automatic expiries.
|
||||||
|
|
||||||
|
Build a persistent resource management module. Adjust
|
||||||
|
`immediate-query` to be able to use an alternative `flush!` routine.
|
||||||
|
|
||||||
|
NOTE that automatic expiry in the direct implementation is as simple
|
||||||
|
as `stop-when-timeout`, but cannot be this simple in a persistent
|
||||||
|
implementation: instead, I plan on producing a special "expiries"
|
||||||
|
table, each entry of which specifies a message to send upon expiry.
|
||||||
|
|
||||||
|
NOTE that the trick of producing a base `p:follow` grant record on
|
||||||
|
account creation has to be done differently when there's no
|
||||||
|
always-on account process.
|
||||||
|
|
||||||
|
NOTE that the trick of deleting an `invitation` when a matching
|
||||||
|
`in-conversation` appears also has to be done differently, similarly
|
||||||
|
to the `p:follow` grant mentioned above. However, this might be able
|
||||||
|
to be automated: if there's some kind of `(stop-when E)` where `E`
|
||||||
|
mentions some field or fields of a resource, matching resources can
|
||||||
|
be deleted from the persistent store by an auxiliary process. This
|
||||||
|
would require fairly hairy syntactic analysis though, so it might be
|
||||||
|
better to have some kind of `cascading-delete-when` form to spell
|
||||||
|
out what should be removed on a given event. (Then the `p:follow`
|
||||||
|
case above can be implemented with some kind of
|
||||||
|
`cascading-insert-when`?)
|
||||||
|
|
||||||
|
NOTE that these differences are OK: this is the first time Syndicate
|
||||||
|
has tackled persistence at all in any interesting way.
|
|
@ -0,0 +1,27 @@
|
||||||
|
#lang syndicate
|
||||||
|
|
||||||
|
(require racket/set)
|
||||||
|
|
||||||
|
(require/activate syndicate/reload)
|
||||||
|
(require/activate syndicate/supervise)
|
||||||
|
|
||||||
|
(require "protocol.rkt")
|
||||||
|
(require "duplicate.rkt")
|
||||||
|
|
||||||
|
(spawn #:name 'account-manager
|
||||||
|
(stop-when-reloaded)
|
||||||
|
(define/query-set accounts (account $e) e)
|
||||||
|
(on (asserted (session $email _))
|
||||||
|
(when (not (set-member? (accounts) email))
|
||||||
|
(send! (create-resource (account email))))))
|
||||||
|
|
||||||
|
(spawn #:name 'account-factory
|
||||||
|
(stop-when-reloaded)
|
||||||
|
(on (message (create-resource ($ a (account $email))))
|
||||||
|
(spawn #:name (list 'account email)
|
||||||
|
(on-start (log-info "Account ~s created." email))
|
||||||
|
(on-stop (log-info "Account ~s deleted." email))
|
||||||
|
(assert a)
|
||||||
|
(assert (grant email email email (p:follow email) #t))
|
||||||
|
(stop-when-duplicate a)
|
||||||
|
(stop-when (message (delete-resource a))))))
|
|
@ -0,0 +1,78 @@
|
||||||
|
#lang syndicate
|
||||||
|
|
||||||
|
(require/activate syndicate/reload)
|
||||||
|
(require/activate syndicate/supervise)
|
||||||
|
(require/activate syndicate/broker/server)
|
||||||
|
(require/activate syndicate/drivers/web)
|
||||||
|
(require/activate "trust.rkt")
|
||||||
|
|
||||||
|
(require "protocol.rkt")
|
||||||
|
(require "session-cookie.rkt")
|
||||||
|
|
||||||
|
(spawn #:name 'broker-listener
|
||||||
|
(stop-when-reloaded)
|
||||||
|
(on (web-request-get (id req) _ ("broker" ()))
|
||||||
|
(when (web-request-header-websocket-upgrade? req)
|
||||||
|
(with-session id
|
||||||
|
[(email sid)
|
||||||
|
(define (scope v) (api (session email sid) v))
|
||||||
|
(spawn-broker-server-connection
|
||||||
|
id
|
||||||
|
req
|
||||||
|
#:scope scope
|
||||||
|
#:hook (lambda ()
|
||||||
|
(stop-when (message (end-session sid)))
|
||||||
|
(stop-when (message (delete-resource (account email))))))]
|
||||||
|
[else
|
||||||
|
(web-respond/xexpr! id
|
||||||
|
#:header (web-response-header #:code 401
|
||||||
|
#:message #"Unauthorized")
|
||||||
|
`(html (body (h1 "Unauthorized")
|
||||||
|
(a ((href "/")) "Login"))))]))))
|
||||||
|
|
||||||
|
(supervise
|
||||||
|
(spawn #:name 'reflect-trust
|
||||||
|
(stop-when-reloaded)
|
||||||
|
(during (session $who _)
|
||||||
|
(during ($ p (permitted _ who _ _))
|
||||||
|
(assert (api (session who _) p)))
|
||||||
|
(during ($ r (permission-request _ who _))
|
||||||
|
(assert (api (session who _) r)))
|
||||||
|
(during ($ g (grant _ who _ _ _))
|
||||||
|
(assert (api (session who _) g)))
|
||||||
|
(during ($ c (contact-list-entry who _))
|
||||||
|
(assert (api (session who _) c))))))
|
||||||
|
|
||||||
|
(supervise
|
||||||
|
(spawn #:name 'reflect-grant-requests
|
||||||
|
(stop-when-reloaded)
|
||||||
|
(during (permission-request $issuer $grantee $permission)
|
||||||
|
(define r (permission-request issuer grantee permission))
|
||||||
|
(during (permitted issuer $grantor permission #t)
|
||||||
|
(assert (api (session grantor _) r))
|
||||||
|
(on (message (api (session grantor _) (delete-resource r)))
|
||||||
|
(send! (delete-resource r)))))))
|
||||||
|
|
||||||
|
(supervise
|
||||||
|
(spawn #:name 'take-trust-instructions
|
||||||
|
(stop-when-reloaded)
|
||||||
|
|
||||||
|
(on (message (api (session $grantor _) (create-resource (? grant? $g))))
|
||||||
|
(when (equal? grantor (grant-grantor g))
|
||||||
|
(send! (create-resource g))))
|
||||||
|
(on (message (api (session $grantor _) (delete-resource (? grant? $g))))
|
||||||
|
(when (or (equal? grantor (grant-grantor g))
|
||||||
|
(equal? grantor (grant-issuer g)))
|
||||||
|
(send! (delete-resource g))))
|
||||||
|
|
||||||
|
(on (message (api (session $principal _) (delete-resource (? permitted? $p))))
|
||||||
|
(when (or (equal? principal (permitted-email p)) ;; relinquish
|
||||||
|
(equal? principal (permitted-issuer p))) ;; revoke; TODO: deal with delegation
|
||||||
|
(send! (delete-resource p))))
|
||||||
|
|
||||||
|
(on (message (api (session $grantee _) (create-resource (? permission-request? $r))))
|
||||||
|
(when (equal? grantee (permission-request-grantee r))
|
||||||
|
(send! (create-resource r))))
|
||||||
|
(on (message (api (session $grantee _) (delete-resource (? permission-request? $r))))
|
||||||
|
(when (equal? grantee (permission-request-grantee r))
|
||||||
|
(send! (delete-resource r))))))
|
|
@ -0,0 +1,54 @@
|
||||||
|
#lang syndicate
|
||||||
|
|
||||||
|
(require racket/cmdline)
|
||||||
|
(require racket/port)
|
||||||
|
|
||||||
|
(require/activate syndicate/reload)
|
||||||
|
(require/activate syndicate/supervise)
|
||||||
|
(require/activate syndicate/drivers/config)
|
||||||
|
(require/activate syndicate/drivers/web)
|
||||||
|
(require/activate syndicate/drivers/smtp)
|
||||||
|
|
||||||
|
(require "protocol.rkt")
|
||||||
|
|
||||||
|
(command-line #:program "webchat"
|
||||||
|
|
||||||
|
#:once-each
|
||||||
|
["--baseurl" baseurl "Specify the base URL for the server"
|
||||||
|
(spawn #:name (list 'command-line-baseurl baseurl)
|
||||||
|
(stop-when-reloaded)
|
||||||
|
(assert (config 'command-line (list 'baseurl baseurl))))]
|
||||||
|
["--listen" port "Specify HTTP listener port"
|
||||||
|
(spawn #:name (list 'command-line-listen port)
|
||||||
|
(stop-when-reloaded)
|
||||||
|
(assert (config 'command-line (list 'listen (string->number port)))))]
|
||||||
|
|
||||||
|
#:multi
|
||||||
|
[("-o" "--option") key vals "Specify a single configuration option"
|
||||||
|
(spawn #:name (list 'config-option key vals)
|
||||||
|
(stop-when-reloaded)
|
||||||
|
(assert (config 'command-line
|
||||||
|
(cons (string->symbol key)
|
||||||
|
(port->list read (open-input-string vals))))))]
|
||||||
|
[("-f" "--config-file") filename "Specify a configuration file to load"
|
||||||
|
(spawn-configuration filename filename
|
||||||
|
#:hook (lambda () (stop-when-reloaded)))])
|
||||||
|
|
||||||
|
(spawn #:name 'main
|
||||||
|
(stop-when-reloaded)
|
||||||
|
|
||||||
|
(during (config _ (list 'baseurl $u)) (assert (server-baseurl u)))
|
||||||
|
(during (config _ (list 'listen $p)) (assert (web-virtual-host "http" _ p)))
|
||||||
|
|
||||||
|
(during/spawn (config _ (list 'load $module-path))
|
||||||
|
#:spawn supervise/spawn
|
||||||
|
#:name (list 'load module-path)
|
||||||
|
(reloader-mixin* module-path))
|
||||||
|
|
||||||
|
(during (config _ (list 'smtp $h $u $p $m))
|
||||||
|
(match h
|
||||||
|
[(regexp #px"(.*):(.*)" (list _ host port))
|
||||||
|
(assert (smtp-account-config 'smtp-service host #:port (string->number port)
|
||||||
|
#:user u #:password p #:ssl-mode m))]
|
||||||
|
[_
|
||||||
|
(assert (smtp-account-config 'smtp-service h #:user u #:password p #:ssl-mode m))])))
|
|
@ -0,0 +1,87 @@
|
||||||
|
#lang syndicate
|
||||||
|
|
||||||
|
(require/activate syndicate/reload)
|
||||||
|
(require/activate syndicate/supervise)
|
||||||
|
(require/activate "trust.rkt")
|
||||||
|
(require/activate "qa.rkt")
|
||||||
|
|
||||||
|
(require "protocol.rkt")
|
||||||
|
(require "duplicate.rkt")
|
||||||
|
|
||||||
|
;; TODO: Move to protocol.rkt
|
||||||
|
(struct online () #:prefab)
|
||||||
|
(struct present (email) #:prefab)
|
||||||
|
|
||||||
|
(supervise
|
||||||
|
(spawn #:name 'reflect-presence
|
||||||
|
(stop-when-reloaded)
|
||||||
|
(during (api (session $who _) (online))
|
||||||
|
(during (permitted who $grantee (p:follow who) _)
|
||||||
|
;; `who` allows `grantee` to follow them
|
||||||
|
(assert (api (session grantee _) (present who)))))))
|
||||||
|
|
||||||
|
(supervise
|
||||||
|
(spawn #:name 'ensure-p:follow-symmetric
|
||||||
|
(stop-when-reloaded)
|
||||||
|
(on (asserted (permitted $A $B (p:follow $maybe-A) _))
|
||||||
|
(when (equal? A maybe-A)
|
||||||
|
(send! (create-resource (permission-request B A (p:follow B))))))
|
||||||
|
(on (retracted (permitted $A $B (p:follow $maybe-A) _))
|
||||||
|
(when (equal? A maybe-A)
|
||||||
|
(send! (delete-resource (permission-request B A (p:follow B))))
|
||||||
|
(send! (delete-resource (permitted B A (p:follow B) ?)))))
|
||||||
|
(on (retracted (permission-request $A $B (p:follow $maybe-A)))
|
||||||
|
(when (equal? A maybe-A)
|
||||||
|
(when (not (immediate-query [query-value #f (permitted A B (p:follow A) _) #t]))
|
||||||
|
(send! (delete-resource (permitted B A (p:follow B) ?))))))))
|
||||||
|
|
||||||
|
(supervise
|
||||||
|
(spawn #:name 'contact-list-factory
|
||||||
|
(stop-when-reloaded)
|
||||||
|
(during (permission-request $A $B (p:follow $maybe-A))
|
||||||
|
(when (equal? A maybe-A)
|
||||||
|
(assert (contact-list-entry B A))))
|
||||||
|
(during (permitted $A $B (p:follow $maybe-A) _)
|
||||||
|
(when (equal? A maybe-A)
|
||||||
|
(when (string<? A B)
|
||||||
|
(during (permitted B A (p:follow B) _)
|
||||||
|
(assert (contact-list-entry A B))
|
||||||
|
(assert (contact-list-entry B A))))))))
|
||||||
|
|
||||||
|
(supervise
|
||||||
|
(spawn #:name 'contact-list-change-log
|
||||||
|
(stop-when-reloaded)
|
||||||
|
(on (asserted (contact-list-entry $owner $member))
|
||||||
|
(log-info "~s adds ~s to their contact list" owner member))
|
||||||
|
(on (retracted (contact-list-entry $owner $member))
|
||||||
|
(log-info "~s removes ~s from their contact list" owner member))))
|
||||||
|
|
||||||
|
(supervise
|
||||||
|
(spawn #:name 'contacts:questions
|
||||||
|
(stop-when-reloaded)
|
||||||
|
;; TODO: CHECK THE FOLLOWING: When the `permission-request` vanishes (due to
|
||||||
|
;; satisfaction or rejection), this should remove the question from all eligible
|
||||||
|
;; answerers at once
|
||||||
|
(during (permission-request $who $grantee ($ p (p:follow _)))
|
||||||
|
(when (equal? who (p:follow-email p))
|
||||||
|
;; `grantee` wants to follow `who`
|
||||||
|
(during (permitted who $grantor p #t)
|
||||||
|
;; `grantor` can make that decision
|
||||||
|
(define-values (title blurb)
|
||||||
|
(if (equal? who grantor)
|
||||||
|
(values (format "Contact request from ~a" grantee)
|
||||||
|
`(p "User " (b ,grantee) " wants to be able to invite you "
|
||||||
|
"to conversations and see when you are online."))
|
||||||
|
(values (format "Contact request from ~a to ~a" grantee who)
|
||||||
|
`(p "User " (b ,grantee) " wants to be able to invite "
|
||||||
|
(b ,who) " to conversations and see when they are online."))))
|
||||||
|
(define qid
|
||||||
|
(ask-question! #:title title #:blurb blurb #:target grantor #:class "q-follow"
|
||||||
|
(option-question (list (list "allow" "Accept")
|
||||||
|
(list "deny" "Reject")
|
||||||
|
(list "ignore" "Ignore")))))
|
||||||
|
(stop-when (asserted (answer qid $v))
|
||||||
|
(match v
|
||||||
|
["allow" (send! (create-resource (grant who grantor grantee p #f)))]
|
||||||
|
["deny" (send! (delete-resource (permission-request who grantee p)))]
|
||||||
|
["ignore" (void)])))))))
|
|
@ -0,0 +1,164 @@
|
||||||
|
#lang syndicate
|
||||||
|
|
||||||
|
(require racket/port)
|
||||||
|
(require markdown)
|
||||||
|
|
||||||
|
(require/activate syndicate/reload)
|
||||||
|
(require/activate syndicate/supervise)
|
||||||
|
(require/activate "trust.rkt")
|
||||||
|
|
||||||
|
(require "protocol.rkt")
|
||||||
|
(require "duplicate.rkt")
|
||||||
|
(require "util.rkt")
|
||||||
|
|
||||||
|
(define (user-in-conversation? who cid)
|
||||||
|
(immediate-query [query-value #f (in-conversation cid who) #t]))
|
||||||
|
|
||||||
|
(supervise
|
||||||
|
(spawn #:name 'take-conversation-instructions
|
||||||
|
(stop-when-reloaded)
|
||||||
|
|
||||||
|
(on (message (api (session $creator _) (create-resource (? conversation? $c))))
|
||||||
|
(when (equal? creator (conversation-creator c))
|
||||||
|
(send! (create-resource c))))
|
||||||
|
(on (message (api (session $updater _) (update-resource (? conversation? $c))))
|
||||||
|
(when (user-in-conversation? updater (conversation-id c))
|
||||||
|
(send! (update-resource c))))
|
||||||
|
(on (message (api (session $creator _) (delete-resource (? conversation? $c))))
|
||||||
|
(when (equal? creator (conversation-creator c))
|
||||||
|
(send! (delete-resource c))))
|
||||||
|
|
||||||
|
(on (message (api (session $joiner _) (create-resource (? in-conversation? $i))))
|
||||||
|
(when (equal? joiner (in-conversation-member i))
|
||||||
|
(send! (create-resource i))))
|
||||||
|
(on (message (api (session $leaver _) (delete-resource (? in-conversation? $i))))
|
||||||
|
(when (equal? leaver (in-conversation-member i))
|
||||||
|
(send! (delete-resource i))))
|
||||||
|
|
||||||
|
(on (message (api (session $inviter _) (create-resource (? invitation? $i))))
|
||||||
|
(when (equal? inviter (invitation-inviter i))
|
||||||
|
(send! (create-resource i))))
|
||||||
|
(on (message (api (session $who _) (delete-resource (? invitation? $i))))
|
||||||
|
(when (or (equal? who (invitation-inviter i))
|
||||||
|
(equal? who (invitation-invitee i)))
|
||||||
|
(send! (delete-resource i))))
|
||||||
|
|
||||||
|
(on (message (api (session $who _) (create-resource (? post? $p))))
|
||||||
|
(when (and (user-in-conversation? who (post-conversation-id p))
|
||||||
|
(equal? who (post-author p)))
|
||||||
|
(send! (create-resource p))))
|
||||||
|
(on (message (api (session $who _) (update-resource (? post? $p))))
|
||||||
|
(when (equal? who (post-author p))
|
||||||
|
(send! (update-resource p))))
|
||||||
|
(on (message (api (session $who _) (delete-resource (? post? $p))))
|
||||||
|
(when (equal? who (post-author p))
|
||||||
|
(send! (delete-resource p))))))
|
||||||
|
|
||||||
|
(supervise
|
||||||
|
(spawn #:name 'relay-conversation-state
|
||||||
|
(stop-when-reloaded)
|
||||||
|
|
||||||
|
(during (invitation $cid $inviter $invitee)
|
||||||
|
(assert (api (session invitee _) (invitation cid inviter invitee)))
|
||||||
|
(during ($ c (conversation cid _ _ _))
|
||||||
|
(assert (api (session invitee _) c))))
|
||||||
|
|
||||||
|
(during (in-conversation $cid $who)
|
||||||
|
(during ($ i (invitation cid _ _))
|
||||||
|
(assert (api (session who _) i)))
|
||||||
|
(during ($ i (in-conversation cid _))
|
||||||
|
(assert (api (session who _) i)))
|
||||||
|
(during ($ c (conversation cid _ _ _))
|
||||||
|
(assert (api (session who _) c)))
|
||||||
|
(during ($ p (post _ _ cid _ _))
|
||||||
|
(assert (api (session who _) p))))))
|
||||||
|
|
||||||
|
(supervise
|
||||||
|
(spawn #:name 'conversation-factory
|
||||||
|
(stop-when-reloaded)
|
||||||
|
(on (message (create-resource ($ c0 (conversation $cid $title0 $creator $blurb0))))
|
||||||
|
(spawn #:name c0
|
||||||
|
(field [title title0]
|
||||||
|
[blurb blurb0])
|
||||||
|
(define/dataflow c (conversation cid (title) creator (blurb)))
|
||||||
|
(on-start (log-info "~v created" (c)))
|
||||||
|
(on-stop (log-info "~v deleted" (c)))
|
||||||
|
(assert (c))
|
||||||
|
(stop-when-duplicate (list 'conversation cid))
|
||||||
|
(stop-when (message (delete-resource (conversation cid _ _ _))))
|
||||||
|
(on (message (update-resource (conversation cid $newtitle _ $newblurb)))
|
||||||
|
(title newtitle)
|
||||||
|
(blurb newblurb))))))
|
||||||
|
|
||||||
|
(supervise
|
||||||
|
(spawn #:name 'in-conversation-factory
|
||||||
|
(stop-when-reloaded)
|
||||||
|
(on (message (create-resource ($ i (in-conversation $cid $who))))
|
||||||
|
(spawn #:name i
|
||||||
|
(on-start (log-info "~s joins conversation ~a" who cid))
|
||||||
|
(on-stop (log-info "~s leaves conversation ~a" who cid))
|
||||||
|
(assert i)
|
||||||
|
(stop-when-duplicate i)
|
||||||
|
(stop-when (message (delete-resource i)))
|
||||||
|
(stop-when (message (delete-resource (conversation cid _ _ _))))))))
|
||||||
|
|
||||||
|
(supervise
|
||||||
|
(spawn #:name 'invitation-factory
|
||||||
|
(stop-when-reloaded)
|
||||||
|
(on (message (create-resource ($ i (invitation $cid $inviter $invitee))))
|
||||||
|
(spawn #:name i
|
||||||
|
(on-start (log-info "~s invited to conversation ~a by ~s" invitee cid inviter))
|
||||||
|
(on-stop (log-info "invitation of ~s to conversation ~a by ~s retracted"
|
||||||
|
invitee cid inviter))
|
||||||
|
(assert i)
|
||||||
|
(stop-when-duplicate i)
|
||||||
|
(stop-when (message (delete-resource i)))
|
||||||
|
(stop-when (message (delete-resource (conversation cid _ _ _))))
|
||||||
|
(stop-when (asserted (in-conversation cid invitee)))))))
|
||||||
|
|
||||||
|
(supervise
|
||||||
|
(spawn #:name 'post-factory
|
||||||
|
(stop-when-reloaded)
|
||||||
|
(on (message (create-resource
|
||||||
|
($ p0 (post $pid $timestamp $cid $author $items0))))
|
||||||
|
(spawn #:name p0
|
||||||
|
(field [items items0])
|
||||||
|
(define/dataflow p (post pid timestamp cid author (items)))
|
||||||
|
(assert (p))
|
||||||
|
(stop-when-duplicate (list 'post cid pid))
|
||||||
|
(stop-when (message (delete-resource (post pid _ cid _ _))))
|
||||||
|
(stop-when (message (delete-resource (conversation cid _ _ _))))
|
||||||
|
(on (message (update-resource (post pid _ cid _ $newitems)))
|
||||||
|
(items newitems))))))
|
||||||
|
|
||||||
|
(supervise
|
||||||
|
(spawn #:name 'conversation:questions
|
||||||
|
(stop-when-reloaded)
|
||||||
|
;; TODO: CHECK THE FOLLOWING: When the `invitation` vanishes (due to satisfaction
|
||||||
|
;; or rejection), this should remove the question from all eligible answerers at once
|
||||||
|
(during (invitation $cid $inviter $invitee)
|
||||||
|
;; `inviter` has invited `invitee` to conversation `cid`...
|
||||||
|
(define qid (random-hex-string 32)) ;; Fix qid and timestamp even as title/creator vary
|
||||||
|
(define timestamp (current-seconds))
|
||||||
|
(during (conversation cid $title $creator _)
|
||||||
|
;; ...and it exists...
|
||||||
|
(during (permitted invitee inviter (p:follow invitee) _)
|
||||||
|
;; ...and they are permitted to do so
|
||||||
|
(assert (question qid timestamp "q-invitation" invitee
|
||||||
|
(format "Invitation from ~a" inviter)
|
||||||
|
(with-output-to-string
|
||||||
|
(lambda ()
|
||||||
|
(display-xexpr
|
||||||
|
`(div
|
||||||
|
(p "You have been invited by " (b ,inviter)
|
||||||
|
" to join a conversation started by " (b ,creator) ".")
|
||||||
|
(p "The conversation is titled "
|
||||||
|
(i "\"" ,title "\"") ".")))))
|
||||||
|
(option-question (list (list "join" "Join conversation")
|
||||||
|
(list "decline" "Decline invitation")))))
|
||||||
|
(stop-when (asserted (answer qid $v))
|
||||||
|
(match v
|
||||||
|
["join"
|
||||||
|
(send! (create-resource (in-conversation cid invitee)))]
|
||||||
|
["decline"
|
||||||
|
(send! (delete-resource (invitation cid inviter invitee)))])))))))
|
|
@ -0,0 +1,15 @@
|
||||||
|
#lang syndicate
|
||||||
|
|
||||||
|
(provide stop-when-duplicate)
|
||||||
|
|
||||||
|
(require syndicate/protocol/instance)
|
||||||
|
(require "util.rkt")
|
||||||
|
|
||||||
|
(define (stop-when-duplicate spec)
|
||||||
|
(define id (random-hex-string 16))
|
||||||
|
(assert (instance id spec))
|
||||||
|
(on (asserted (instance $id2 spec))
|
||||||
|
(when (string<? id id2)
|
||||||
|
(log-info "Duplicate instance of ~v detected; terminating" spec)
|
||||||
|
(stop-current-facet)))
|
||||||
|
id)
|
|
@ -0,0 +1,14 @@
|
||||||
|
#lang syndicate
|
||||||
|
|
||||||
|
(require/activate syndicate/reload)
|
||||||
|
|
||||||
|
(spawn-reloader "config.rkt")
|
||||||
|
(spawn-reloader "trust.rkt")
|
||||||
|
(spawn-reloader "api.rkt")
|
||||||
|
(spawn-reloader "script-compiler.rkt")
|
||||||
|
(spawn-reloader "static-content.rkt")
|
||||||
|
(spawn-reloader "account.rkt")
|
||||||
|
(spawn-reloader "pages.rkt")
|
||||||
|
(spawn-reloader "qa.rkt")
|
||||||
|
(spawn-reloader "contacts.rkt")
|
||||||
|
(spawn-reloader "conversation.rkt")
|
|
@ -0,0 +1,277 @@
|
||||||
|
#lang syndicate
|
||||||
|
|
||||||
|
(require racket/dict)
|
||||||
|
(require racket/port)
|
||||||
|
(require racket/set)
|
||||||
|
(require racket/string)
|
||||||
|
(require markdown)
|
||||||
|
(require net/url)
|
||||||
|
(require net/uri-codec)
|
||||||
|
|
||||||
|
(require/activate syndicate/reload)
|
||||||
|
(require/activate syndicate/supervise)
|
||||||
|
(require/activate syndicate/drivers/config)
|
||||||
|
(require/activate syndicate/drivers/smtp)
|
||||||
|
(require/activate syndicate/drivers/timestate)
|
||||||
|
(require/activate syndicate/drivers/web)
|
||||||
|
|
||||||
|
(require "protocol.rkt")
|
||||||
|
(require "duplicate.rkt")
|
||||||
|
(require "session-cookie.rkt")
|
||||||
|
|
||||||
|
(define (page #:head [extra-head '()]
|
||||||
|
#:body-id [body-id #f]
|
||||||
|
;; #:nav-heading [nav-heading `(a ((href "/#/conversations")) "Syndicate Webchat")]
|
||||||
|
title . body-elements)
|
||||||
|
`(html ((lang "en"))
|
||||||
|
(head (meta ((charset "utf-8")))
|
||||||
|
(meta ((http-equiv "X-UA-Compatible") (content "IE=edge")))
|
||||||
|
(meta ((name "viewport") (content "width=device-width, initial-scale=1.0, shrink-to-fit=no")))
|
||||||
|
(meta ((name "format-detection") (content "email=no"))) ;; TODO: Mobile chrome seems to autolink email addresses ?!?!
|
||||||
|
(title ,title)
|
||||||
|
(link ((rel "stylesheet")
|
||||||
|
(href "https://maxcdn.bootstrapcdn.com/bootstrap/4.0.0-alpha.5/css/bootstrap.min.css")
|
||||||
|
(integrity "sha384-AysaV+vQoT3kOAXZkl02PThvDr8HYKPZhNT5h/CXfBThSRXQ6jW5DO2ekP5ViFdi")
|
||||||
|
(crossorigin "anonymous")))
|
||||||
|
(script ((src "https://code.jquery.com/jquery-3.1.1.min.js")
|
||||||
|
(integrity "sha256-hVVnYaiADRTO2PzUGmuLJr8BLUSjGIZsDYGmIJLv2b8=")
|
||||||
|
(crossorigin "anonymous")))
|
||||||
|
(script ((src "https://cdnjs.cloudflare.com/ajax/libs/tether/1.3.8/js/tether.min.js")
|
||||||
|
(integrity "sha256-/5pHDZh2fv1eZImyfiThtB5Ag4LqDjyittT7fLjdT/8=")
|
||||||
|
(crossorigin "anonymous")))
|
||||||
|
(script ((src "https://maxcdn.bootstrapcdn.com/bootstrap/4.0.0-alpha.5/js/bootstrap.min.js")
|
||||||
|
(integrity "sha384-BLiI7JTZm+JWlgKa0M0kGRpJbF2J8q+qreVrKBC47e3K6BW78kGLrCkeRX6I9RoK")
|
||||||
|
(crossorigin "anonymous")))
|
||||||
|
(script ((src "https://cdnjs.cloudflare.com/ajax/libs/mustache.js/2.3.0/mustache.min.js")
|
||||||
|
(integrity "sha256-iaqfO5ue0VbSGcEiQn+OeXxnxAMK2+QgHXIDA5bWtGI=")
|
||||||
|
(crossorigin "anonymous")))
|
||||||
|
(script ((src "https://cdnjs.cloudflare.com/ajax/libs/blueimp-md5/2.6.0/js/md5.min.js")
|
||||||
|
(integrity "sha256-I0CACboBQ1ky299/4LVi2tzEhCOfx1e7LbCcFhn7M8Y=")
|
||||||
|
(crossorigin "anonymous")))
|
||||||
|
(script ((src "https://cdnjs.cloudflare.com/ajax/libs/immutable/3.8.1/immutable.min.js")
|
||||||
|
(integrity "sha256-13JFytp+tj8jsxr6GQOVLCgcYfMUo2Paw4jVrnXLUPE=")
|
||||||
|
(crossorigin "anonymous")))
|
||||||
|
(script ((src "/linkify.min.js")))
|
||||||
|
(script ((src "/linkify-string.min.js")))
|
||||||
|
;; (script ((src "/syndicatecompiler.min.js")))
|
||||||
|
(script ((src "/syndicate.min.js")))
|
||||||
|
(script ((src "/webchat.js")))
|
||||||
|
(link ((rel "stylesheet") (href "http://code.ionicframework.com/ionicons/2.0.1/css/ionicons.min.css")))
|
||||||
|
(link ((rel "stylesheet") (href "/style.css")))
|
||||||
|
,@extra-head)
|
||||||
|
(body (,@(if body-id
|
||||||
|
`((id ,body-id))
|
||||||
|
`()))
|
||||||
|
(div ((class "container main-container"))
|
||||||
|
(div ((class "header clearfix"))
|
||||||
|
(nav ((class "navbar"))
|
||||||
|
;; (span ((id "nav-heading") (class "navbar-brand text-muted")) ,nav-heading)
|
||||||
|
(ul ((id "nav-ul") (class "nav navbar-nav nav-pills float-xs-right"))
|
||||||
|
;; (li ((class "nav-item")) (a ((class "nav-link active") (href "#")) "Home " (span ((class "sr-only")) "(current)")))
|
||||||
|
;; (li ((class "nav-item")) (a ((class "nav-link") (href "#")) "About"))
|
||||||
|
;; (li ((class "nav-item")) (a ((class "nav-link") (href "#")) "Contact"))
|
||||||
|
)))
|
||||||
|
|
||||||
|
(div ((id "main-div")))
|
||||||
|
;; (div ((class "row marketing"))
|
||||||
|
;; (div ((class "col-lg-6"))
|
||||||
|
;; (h4 "Subheading")
|
||||||
|
;; (p "Donec id elit non mi porta gravida at eget metus. Maecenas faucibus mollis interdum.")
|
||||||
|
;; (h4 "Subheading")
|
||||||
|
;; (p "Morbi leo risus, porta ac consectetur ac, vestibulum at eros. Cras mattis consectetur purus sit amet fermentum.")
|
||||||
|
;; (h4 "Subheading")
|
||||||
|
;; (p "Maecenas sed diam eget risus varius blandit sit amet non magna."))
|
||||||
|
;; (div ((class "col-lg-6"))
|
||||||
|
;; (h4 "Subheading")
|
||||||
|
;; (p "Morbi leo risus, porta ac consectetur ac, vestibulum at eros. Cras mattis consectetur purus sit amet fermentum.")
|
||||||
|
;; (h4 "Subheading")
|
||||||
|
;; (p "Maecenas sed diam eget risus varius blandit sit amet non magna.")
|
||||||
|
;; (h4 "Subheading")
|
||||||
|
;; (p "Donec id elit non mi porta gravida at eget metus. Maecenas faucibus mollis interdum.")))
|
||||||
|
|
||||||
|
,@body-elements
|
||||||
|
|
||||||
|
(footer ((class "footer"))
|
||||||
|
(p copy " 2010" ndash "2016 Tony Garnock-Jones"))))))
|
||||||
|
|
||||||
|
(define (jumbotron heading . contents)
|
||||||
|
`(div ((class "jumbotron"))
|
||||||
|
(h1 ((class "display-3")) ,heading)
|
||||||
|
,@contents))
|
||||||
|
|
||||||
|
(define (logout-this-session! id)
|
||||||
|
(web-redirect! id "/" #:headers (list (format-cookie clear-session-cookie))))
|
||||||
|
|
||||||
|
(define (web-respond/pretty-xexpr! id
|
||||||
|
#:header [header (web-response-header)]
|
||||||
|
body-xexpr)
|
||||||
|
(web-respond/bytes! id
|
||||||
|
#:header header
|
||||||
|
(bytes-append #"<!DOCTYPE html>"
|
||||||
|
(with-output-to-bytes
|
||||||
|
(lambda ()
|
||||||
|
;; This is a very nice compromise pretty-printer
|
||||||
|
;; for xexprs from Greg's Markdown package.
|
||||||
|
(display-xexpr body-xexpr))))))
|
||||||
|
|
||||||
|
(spawn #:name 'index-page
|
||||||
|
(stop-when-reloaded)
|
||||||
|
(on (web-request-get (id req) _ ("" ()))
|
||||||
|
(index-page id)))
|
||||||
|
|
||||||
|
(define (index-page id)
|
||||||
|
(with-session id
|
||||||
|
[(email sid)
|
||||||
|
(serve-single-page-app id sid email)]
|
||||||
|
[else
|
||||||
|
(web-respond/pretty-xexpr!
|
||||||
|
id
|
||||||
|
#:header (web-response-header #:headers (list (format-cookie clear-session-cookie)))
|
||||||
|
(page "Syndicate Webchat"
|
||||||
|
(jumbotron "Log In"
|
||||||
|
`(p ((class "lead"))
|
||||||
|
"Enter your email address. You will be emailed a login token.")
|
||||||
|
|
||||||
|
`(form ((action "/login") (method "post") (class "form-inline"))
|
||||||
|
(div ((class "form-group"))
|
||||||
|
(label ((for "email")) "Email:")
|
||||||
|
" "
|
||||||
|
(input ((type "email")
|
||||||
|
(name "email")
|
||||||
|
(id "email")
|
||||||
|
(placeholder "your-email@example.com"))))
|
||||||
|
" "
|
||||||
|
(button ((type "submit")
|
||||||
|
(class "btn btn-success")
|
||||||
|
(role "button"))
|
||||||
|
"Log In")))))]))
|
||||||
|
|
||||||
|
(define (serve-single-page-app id sid email)
|
||||||
|
(web-respond/pretty-xexpr!
|
||||||
|
id
|
||||||
|
(page (format "Webchat: ~a" email)
|
||||||
|
#:body-id "webchat-main"
|
||||||
|
#:head (list `(meta ((itemprop "webchat-session-email") (content ,email)))
|
||||||
|
`(meta ((itemprop "webchat-session-id") (content ,sid)))))))
|
||||||
|
|
||||||
|
;; (define (sessions-page id)
|
||||||
|
;; (with-session id
|
||||||
|
;; [(email sid)
|
||||||
|
;; (define sids (sort (set->list (immediate-query (query-set (session email $s) s))) string<?))
|
||||||
|
;; (web-respond/pretty-xexpr!
|
||||||
|
;; id
|
||||||
|
;; (page "Session Management"
|
||||||
|
;; `(div (h1 "Session Management")
|
||||||
|
;; (ol ,@(for/list [(s sids)]
|
||||||
|
;; `(li (a ((href ,(format "/logout/~a" s)))
|
||||||
|
;; ,s))))
|
||||||
|
;; (p (a ((href "/logout-all"))
|
||||||
|
;; "Logout all sessions"))
|
||||||
|
;; (p (a ((href "/delete-account"))
|
||||||
|
;; "Delete account")))))]))
|
||||||
|
|
||||||
|
;; (define (logout-all-page id)
|
||||||
|
;; (with-session id
|
||||||
|
;; [(email _sid)
|
||||||
|
;; (for [(sid (immediate-query (query-set (session email $s) s)))]
|
||||||
|
;; (send! (end-session sid)))
|
||||||
|
;; (logout-this-session! id)]
|
||||||
|
;; [else (logout-this-session! id)]))
|
||||||
|
|
||||||
|
(spawn #:name 'logout-page
|
||||||
|
(stop-when-reloaded)
|
||||||
|
(on (web-request-get (id req) _ ("logout" ()))
|
||||||
|
(logout-page id)))
|
||||||
|
|
||||||
|
(define (logout-page id)
|
||||||
|
(with-session id
|
||||||
|
[(email sid)
|
||||||
|
(send! (end-session sid))
|
||||||
|
(logout-this-session! id)]
|
||||||
|
[else (logout-this-session! id)]))
|
||||||
|
|
||||||
|
(spawn #:name 'login-page
|
||||||
|
(stop-when-reloaded)
|
||||||
|
(define/query-value insecure #f (config _ (list 'insecure)) #t)
|
||||||
|
(define/query-value baseurl #f (server-baseurl $b) b)
|
||||||
|
|
||||||
|
(on (web-request-incoming (id req) _ 'post ("login" ()) $body)
|
||||||
|
(define params (make-immutable-hash (form-urlencoded->alist (bytes->string/utf-8 body))))
|
||||||
|
(define email (string-trim (dict-ref params 'email "")))
|
||||||
|
(if (string=? email "")
|
||||||
|
(web-redirect! id "/")
|
||||||
|
(let* ((sid (fresh-session-id))
|
||||||
|
(validation-url (url->string
|
||||||
|
(combine-url/relative (string->url (baseurl))
|
||||||
|
(format "/login/~a" sid)))))
|
||||||
|
(spawn-login-link email sid)
|
||||||
|
(login-link-emailed-page id (and (insecure) validation-url))
|
||||||
|
(when (not (insecure))
|
||||||
|
(smtp-deliver! 'smtp-service "webchat@syndicate-lang.org" (list email)
|
||||||
|
(list (cons 'subject "Login link for Syndicate WebChat")
|
||||||
|
(cons 'to email)
|
||||||
|
(cons 'from "webchat@syndicate-lang.org"))
|
||||||
|
(list (format "Hello ~a," email)
|
||||||
|
(format "")
|
||||||
|
(format "Here is your login link for Syndicate WebChat:")
|
||||||
|
(format "")
|
||||||
|
(format " ~a" validation-url))))))))
|
||||||
|
|
||||||
|
(define (spawn-login-link email sid)
|
||||||
|
(spawn #:name (list 'login-link email sid)
|
||||||
|
(on-start (log-info "Login link ~s for ~s activated." sid email))
|
||||||
|
(on-stop (log-info "Login link ~s for ~s deactivated." sid email))
|
||||||
|
(assert (login-link email sid))
|
||||||
|
(stop-when (asserted (session _ sid))) ;; happy path
|
||||||
|
(stop-when (message (end-session sid)))
|
||||||
|
(stop-when (message (delete-resource (account email))))
|
||||||
|
(stop-when-timeout (* (* 24 3600) 1000)))) ;; 24h = 1 day
|
||||||
|
|
||||||
|
(define (login-link-emailed-page id maybe-insecure-validation-url)
|
||||||
|
(web-respond/pretty-xexpr!
|
||||||
|
id
|
||||||
|
(page "Syndicate Webchat"
|
||||||
|
(jumbotron "Login Link Emailed"
|
||||||
|
(if maybe-insecure-validation-url
|
||||||
|
`(p ((class "insecure-mode lead"))
|
||||||
|
"INSECURE MODE: Click "
|
||||||
|
(a ((href ,maybe-insecure-validation-url)) "here")
|
||||||
|
" to log in")
|
||||||
|
`(p ((class "lead"))
|
||||||
|
"A login link should appear "
|
||||||
|
"in your inbox shortly."))))))
|
||||||
|
|
||||||
|
(spawn #:name 'login-link-page
|
||||||
|
(stop-when-reloaded)
|
||||||
|
;; Can't handle the request within each login-link process, since we have to take
|
||||||
|
;; special action if there is no such login link, and we are not allowed to race,
|
||||||
|
;; meaning that this has to be a Single Point Of Control for making decisions based
|
||||||
|
;; on the login-link relation.
|
||||||
|
(on (web-request-get (id req) _ ("login" (,$sid ())))
|
||||||
|
(match (immediate-query (query-value #f (login-link $email sid) email))
|
||||||
|
[#f (login-link-expired-page id)]
|
||||||
|
[email
|
||||||
|
(send! (create-resource (session email sid)))
|
||||||
|
(web-redirect! id "/" #:headers (list (format-cookie (session-id->cookie sid))))])))
|
||||||
|
|
||||||
|
(define (login-link-expired-page id)
|
||||||
|
(web-respond/pretty-xexpr!
|
||||||
|
id
|
||||||
|
(page "Login Link Expired or Invalid"
|
||||||
|
(jumbotron "Login Link Expired or Invalid"
|
||||||
|
`(p ((class "lead"))
|
||||||
|
"Please " (a ((href "/")) "return to the main page") ".")))))
|
||||||
|
|
||||||
|
(supervise
|
||||||
|
(spawn #:name 'session-monitor-factory
|
||||||
|
(stop-when-reloaded)
|
||||||
|
(on (message (create-resource ($ s (session $email $sid))))
|
||||||
|
(spawn #:name (list 'session-monitor email sid)
|
||||||
|
(on-start (log-info "Session ~s for ~s started." sid email))
|
||||||
|
(on-stop (log-info "Session ~s for ~s stopped." sid email))
|
||||||
|
(assert s)
|
||||||
|
(stop-when-duplicate s)
|
||||||
|
(stop-when (message (delete-resource s)))
|
||||||
|
(stop-when (message (delete-resource (account email))))
|
||||||
|
(stop-when (message (end-session sid)))
|
||||||
|
(stop-when-timeout (* 7 86400 1000)))))) ;; 1 week
|
|
@ -0,0 +1,173 @@
|
||||||
|
#lang racket/base
|
||||||
|
|
||||||
|
(provide (all-defined-out)) ;; TODO
|
||||||
|
|
||||||
|
;; A Markup is a String containing very carefully-chosen extensions
|
||||||
|
;; that allow a little bit of plain-text formatting without opening
|
||||||
|
;; the system up to Cross-Site Scripting (XSS) vulnerabilities.
|
||||||
|
|
||||||
|
;;---------------------------------------------------------------------------
|
||||||
|
;; Server State
|
||||||
|
|
||||||
|
;; (server-baseurl URLString)
|
||||||
|
(struct server-baseurl (string) #:prefab) ;; ASSERTION
|
||||||
|
|
||||||
|
;;---------------------------------------------------------------------------
|
||||||
|
;; Session and Account Management
|
||||||
|
|
||||||
|
;; (session EmailString String)
|
||||||
|
;; Represents a live session. Retracted when the session ends.
|
||||||
|
(struct session (email token) #:prefab) ;; ASSERTION
|
||||||
|
|
||||||
|
;; (login-link EmailString String)
|
||||||
|
;; Represents the availability of a non-expired login link. Retracted when the link expires.
|
||||||
|
(struct login-link (email token) #:prefab) ;; ASSERTION
|
||||||
|
|
||||||
|
;; (end-session String)
|
||||||
|
;; Instructs any matching session to terminate.
|
||||||
|
(struct end-session (token) #:prefab) ;; MESSAGE
|
||||||
|
|
||||||
|
;; (account EmailString)
|
||||||
|
;; Represents an extant account.
|
||||||
|
(struct account (email) #:prefab) ;; ASSERTION
|
||||||
|
|
||||||
|
;;---------------------------------------------------------------------------
|
||||||
|
;; API requests and assertions
|
||||||
|
|
||||||
|
;; (api Session Any)
|
||||||
|
;; Represents some value asserted or transmitted on behalf of the
|
||||||
|
;; given user session. Values of this type cannot be trusted, since
|
||||||
|
;; they originate with the user's client, which may be the browser or
|
||||||
|
;; may be some other client.
|
||||||
|
(struct api (session value) #:prefab) ;; ASSERTION AND MESSAGE
|
||||||
|
|
||||||
|
;;---------------------------------------------------------------------------
|
||||||
|
;; Create, Update and Delete
|
||||||
|
|
||||||
|
;; (create-resource Any)
|
||||||
|
;; Request creation of the given resource as described.
|
||||||
|
(struct create-resource (description) #:prefab) ;; MESSAGE
|
||||||
|
|
||||||
|
;; (update-resource Any)
|
||||||
|
;; Request update of the given resource as described.
|
||||||
|
(struct update-resource (description) #:prefab) ;; MESSAGE
|
||||||
|
|
||||||
|
;; (delete-resource Any)
|
||||||
|
;; Request deletion of the given resource as described.
|
||||||
|
(struct delete-resource (description) #:prefab) ;; MESSAGE
|
||||||
|
|
||||||
|
;;---------------------------------------------------------------------------
|
||||||
|
;; Capability Management
|
||||||
|
|
||||||
|
;; A Principal is an EmailString
|
||||||
|
|
||||||
|
;; TODO: Action: report a cap request as spam or some other kind of nuisance
|
||||||
|
|
||||||
|
;; (grant Principal Principal Principal Any Boolean)
|
||||||
|
;; Links in a grant chain.
|
||||||
|
(struct grant (issuer grantor grantee permission delegable?) #:prefab) ;; ASSERTION
|
||||||
|
|
||||||
|
;; (permitted Principal Principal Any Boolean)
|
||||||
|
;; Net results of processing grant chains. Query these.
|
||||||
|
(struct permitted (issuer email permission delegable?) #:prefab) ;; ASSERTION
|
||||||
|
|
||||||
|
;; (permission-request Principal Principal Any)
|
||||||
|
;; Represents an outstanding request for a permission.
|
||||||
|
;; Satisfied by either - appearance of a matching Grant
|
||||||
|
;; - receipt of a matching Revoke
|
||||||
|
;; - receipt of a CancelRequest
|
||||||
|
(struct permission-request (issuer grantee permission) #:prefab) ;; ASSERTION
|
||||||
|
|
||||||
|
;;---------------------------------------------------------------------------
|
||||||
|
;; Contact List Management
|
||||||
|
|
||||||
|
;; M Capability to invite X to a conversation
|
||||||
|
;; W Capability to see onlineness of X
|
||||||
|
;; W Capability to silently block X from contacting one in any way
|
||||||
|
;; W Capability to visibly block X from contacting one in any way
|
||||||
|
;; W Capability to mute an individual outside the context of any particular conversation for a certain length of time
|
||||||
|
|
||||||
|
;; (contact-list-entry Principal Principal)
|
||||||
|
;; Asserts that `member` is a member of the contact list owned by `owner`.
|
||||||
|
(struct contact-list-entry (owner member) #:prefab) ;; ASSERTION
|
||||||
|
|
||||||
|
;; (p:follow Principal)
|
||||||
|
;; When (permitted X Y (p:follow X) _), X says that Y may follow X.
|
||||||
|
(struct p:follow (email) #:prefab)
|
||||||
|
|
||||||
|
;; (struct p:invite (email) #:prefab)
|
||||||
|
;; (struct p:see-presence (email) #:prefab)
|
||||||
|
|
||||||
|
;;---------------------------------------------------------------------------
|
||||||
|
;; Conversation Management
|
||||||
|
|
||||||
|
;; M Capability to destroy a conversation
|
||||||
|
;; M Capability to invite someone inviteable to a conversation
|
||||||
|
;; M Capability to cancel an open invitation
|
||||||
|
;; M Capability to boot someone from a conversation
|
||||||
|
;; M Capability to leave a conversation
|
||||||
|
;; M Capability to reject an invitation to a conversation
|
||||||
|
;; M Capability to accept an invitation to a conversation
|
||||||
|
;; M Capability to see the list of participants in a conversation
|
||||||
|
;; M Capability to publish posts to a conversation
|
||||||
|
;; S Capability to remove or edit one's own posts
|
||||||
|
;; S Capability to remove or edit other people's posts
|
||||||
|
;; C Capability to clear conversation history
|
||||||
|
;; C Capability to react to a post on a conversation
|
||||||
|
;; W Capability to delegate capabilities to others
|
||||||
|
;; W Capability to mute a conversation for a certain length of time
|
||||||
|
;; W Capability to mute an individual within the context of a particular conversation for a certain length of time
|
||||||
|
;; W Capability to have a conversation joinable by ID, without an invitation
|
||||||
|
;; W Capability to have a conversation be publicly viewable
|
||||||
|
;; W Capability to draft posts before publication
|
||||||
|
;; W Capability to approve draft posts
|
||||||
|
|
||||||
|
;; TODO: For now, all members will have all conversation control
|
||||||
|
;; abilities. Later, these can be split out into separate permissions.
|
||||||
|
|
||||||
|
;; Attribute: conversation title
|
||||||
|
;; Attribute: conversation creator
|
||||||
|
;; Attribute: conversation blurb
|
||||||
|
;; Attribute: conversation members
|
||||||
|
|
||||||
|
;; Simple posting is a combination of draft+approve.
|
||||||
|
;; Flagging a post for moderator attention is a kind of reaction.
|
||||||
|
|
||||||
|
;; (conversation String String Principal Markup Boolean
|
||||||
|
(struct conversation (id title creator blurb) #:prefab) ;; ASSERTION
|
||||||
|
|
||||||
|
;; (invitation String Principal Principal)
|
||||||
|
(struct invitation (conversation-id inviter invitee) #:prefab) ;; ASSERTION
|
||||||
|
|
||||||
|
;; (in-conversation String Principal)
|
||||||
|
;; Records conversation membership.
|
||||||
|
(struct in-conversation (conversation-id member) #:prefab) ;; ASSERTION
|
||||||
|
|
||||||
|
(struct post (id ;; String
|
||||||
|
timestamp ;; Seconds
|
||||||
|
conversation-id ;; String
|
||||||
|
author ;; Principal
|
||||||
|
items ;; Listof DataURLString
|
||||||
|
) #:prefab) ;; ASSERTION
|
||||||
|
|
||||||
|
;;---------------------------------------------------------------------------
|
||||||
|
;; User Interaction
|
||||||
|
|
||||||
|
;; (ui-template String String)
|
||||||
|
;; A fragment of HTML for use in the web client.
|
||||||
|
(struct ui-template (name data) #:prefab) ;; ASSERTION
|
||||||
|
|
||||||
|
;; (question String Seconds String Principal String Markup QuestionType)
|
||||||
|
(struct question (id timestamp class target title blurb type) #:prefab) ;; ASSERTION
|
||||||
|
|
||||||
|
;; (answer String Any)
|
||||||
|
(struct answer (id value) #:prefab) ;; MESSAGE
|
||||||
|
|
||||||
|
;; A QuestionType is one of
|
||||||
|
;; - (yes/no-question Markup Markup)
|
||||||
|
;; - (option-question (Listof (List Any Markup)))
|
||||||
|
;; - (text-question Boolean)
|
||||||
|
(struct yes/no-question (false-value true-value) #:prefab)
|
||||||
|
(struct option-question (options) #:prefab)
|
||||||
|
(struct text-question (multiline?) #:prefab)
|
||||||
|
(struct acknowledge-question () #:prefab)
|
|
@ -0,0 +1,41 @@
|
||||||
|
#lang syndicate
|
||||||
|
|
||||||
|
(provide ask-question!)
|
||||||
|
|
||||||
|
(require racket/port)
|
||||||
|
(require markdown)
|
||||||
|
|
||||||
|
(require/activate syndicate/reload)
|
||||||
|
(require/activate syndicate/supervise)
|
||||||
|
|
||||||
|
(require "protocol.rkt")
|
||||||
|
(require "util.rkt")
|
||||||
|
|
||||||
|
(supervise
|
||||||
|
(spawn #:name 'qa-relay
|
||||||
|
(stop-when-reloaded)
|
||||||
|
(during ($ q (question _ _ _ _ _ _ _))
|
||||||
|
(define qid (question-id q))
|
||||||
|
(define target (question-target q))
|
||||||
|
(assert (api (session target _) q))
|
||||||
|
(during (api (session target _) (answer qid $value))
|
||||||
|
(assert (answer qid value))))))
|
||||||
|
|
||||||
|
(define (ask-question! #:title title
|
||||||
|
#:blurb blurb
|
||||||
|
#:class [q-class "q-generic"]
|
||||||
|
#:target target
|
||||||
|
question-type)
|
||||||
|
(define qid (random-hex-string 32))
|
||||||
|
(define q (question qid
|
||||||
|
(current-seconds)
|
||||||
|
q-class
|
||||||
|
target
|
||||||
|
title
|
||||||
|
(with-output-to-string
|
||||||
|
(lambda ()
|
||||||
|
(display-xexpr blurb)))
|
||||||
|
question-type))
|
||||||
|
(assert q)
|
||||||
|
qid)
|
||||||
|
|
|
@ -0,0 +1,5 @@
|
||||||
|
#!/bin/sh
|
||||||
|
SYNDICATE_TRACE=${SYNDICATE_TRACE:-_}
|
||||||
|
SYNDICATE_STDOUT_TO_STDERR=y
|
||||||
|
export SYNDICATE_TRACE SYNDICATE_STDOUT_TO_STDERR
|
||||||
|
exec racketmake main.rkt -f testing.rktd 2>&1 | tai64n | tai64nlocal
|
|
@ -0,0 +1,25 @@
|
||||||
|
#lang syndicate
|
||||||
|
|
||||||
|
(require racket/file)
|
||||||
|
(require racket/port)
|
||||||
|
(require racket/system)
|
||||||
|
|
||||||
|
(require/activate syndicate/reload)
|
||||||
|
(require/activate syndicate/drivers/filesystem)
|
||||||
|
(require/activate syndicate/drivers/web)
|
||||||
|
|
||||||
|
(spawn #:name 'script-compiler
|
||||||
|
(stop-when-reloaded)
|
||||||
|
(define source-filename "../htdocs/webchat.syndicate.js")
|
||||||
|
(define target-filename "webchat.js")
|
||||||
|
(during/spawn (file-content source-filename file->bytes $bs)
|
||||||
|
#:name (list 'compiled source-filename)
|
||||||
|
(define compiled (with-output-to-bytes
|
||||||
|
(lambda () (system* "../../../js/bin/syndicatec" source-filename))))
|
||||||
|
(log-info "Finished compiling ~s" target-filename)
|
||||||
|
(on (web-request-get (id req) _ (,target-filename ()))
|
||||||
|
(web-respond/bytes! id
|
||||||
|
#:header (web-response-header
|
||||||
|
#:headers (list (cons 'content-type
|
||||||
|
"application/javascript")))
|
||||||
|
compiled))))
|
|
@ -0,0 +1,54 @@
|
||||||
|
#lang racket/base
|
||||||
|
|
||||||
|
(provide COOKIE
|
||||||
|
clear-session-cookie
|
||||||
|
format-cookie
|
||||||
|
fresh-session-id
|
||||||
|
session-id->cookie
|
||||||
|
with-session)
|
||||||
|
|
||||||
|
(require racket/list)
|
||||||
|
(require racket/match)
|
||||||
|
(require racket/set)
|
||||||
|
(require web-server/http/request-structs)
|
||||||
|
(require web-server/http/cookie)
|
||||||
|
|
||||||
|
(require syndicate/actor)
|
||||||
|
(require syndicate/drivers/web)
|
||||||
|
|
||||||
|
(require "protocol.rkt")
|
||||||
|
(require "util.rkt")
|
||||||
|
|
||||||
|
(define COOKIE "syndicatewebchat")
|
||||||
|
|
||||||
|
(define clear-session-cookie (make-cookie COOKIE
|
||||||
|
""
|
||||||
|
#:path "/"
|
||||||
|
#:expires "Thu, 01 Jan 1970 00:00:00 GMT"))
|
||||||
|
|
||||||
|
(define (format-cookie c)
|
||||||
|
(match-define (header field value) (cookie->header c))
|
||||||
|
(cons (string->symbol (string-downcase (bytes->string/latin-1 field)))
|
||||||
|
(bytes->string/utf-8 value)))
|
||||||
|
|
||||||
|
(define (fresh-session-id)
|
||||||
|
(random-hex-string 32))
|
||||||
|
|
||||||
|
(define (session-id->cookie sid)
|
||||||
|
(make-cookie COOKIE sid #:path "/"))
|
||||||
|
|
||||||
|
(define-syntax with-session
|
||||||
|
(syntax-rules (else)
|
||||||
|
[(_ id [(email sid) body ...])
|
||||||
|
(with-session id [(email sid) body ...] [else (web-redirect! id "/")])]
|
||||||
|
[(_ id [(email sid) body ...] [else no-session-body ...])
|
||||||
|
(let ()
|
||||||
|
(define (on-no-session)
|
||||||
|
no-session-body ...)
|
||||||
|
(match (immediate-query (query-value #f (web-request-cookie id COOKIE $v _ _) v))
|
||||||
|
[#f (on-no-session)]
|
||||||
|
[sid
|
||||||
|
(match (immediate-query (query-value #f (session $e sid) e))
|
||||||
|
[#f (on-no-session)]
|
||||||
|
[email
|
||||||
|
body ...])]))]))
|
|
@ -0,0 +1,45 @@
|
||||||
|
#lang syndicate
|
||||||
|
|
||||||
|
(require racket/file)
|
||||||
|
(require racket/runtime-path)
|
||||||
|
(require net/url)
|
||||||
|
(require web-server/dispatchers/filesystem-map)
|
||||||
|
(require web-server/private/mime-types)
|
||||||
|
|
||||||
|
(require "protocol.rkt")
|
||||||
|
|
||||||
|
(require/activate syndicate/reload)
|
||||||
|
(require/activate syndicate/drivers/filesystem)
|
||||||
|
(require/activate syndicate/drivers/web)
|
||||||
|
|
||||||
|
(begin-for-declarations
|
||||||
|
(define-runtime-path htdocs-path "../htdocs")
|
||||||
|
(define-runtime-path templates-path "../htdocs/templates")
|
||||||
|
(define-runtime-path syndicate-js-dist-path "../../../js/dist")
|
||||||
|
(define path->mime-type (make-path->mime-type "/etc/mime.types")))
|
||||||
|
|
||||||
|
(spawn #:name 'static-content-server
|
||||||
|
(stop-when-reloaded)
|
||||||
|
(define static-paths (list htdocs-path syndicate-js-dist-path))
|
||||||
|
(define url->path-fns (map make-url->path static-paths))
|
||||||
|
(define (url->existing-static-path u)
|
||||||
|
(for/or [(url->path (in-list url->path-fns))]
|
||||||
|
(define-values (path path-pieces) (url->path u))
|
||||||
|
(and (file-exists? path) path)))
|
||||||
|
(on (web-request-get (id req) _ ,_)
|
||||||
|
(define path (url->existing-static-path
|
||||||
|
(resource->url (web-request-header-resource req))))
|
||||||
|
(when path
|
||||||
|
(web-respond/bytes! id
|
||||||
|
#:header (web-response-header #:mime-type (path->mime-type path))
|
||||||
|
(file->bytes path)))))
|
||||||
|
|
||||||
|
(spawn #:name 'template-server
|
||||||
|
(stop-when-reloaded)
|
||||||
|
(define url->path (make-url->path templates-path))
|
||||||
|
(during (api _ (observe (ui-template $name _)))
|
||||||
|
(define-values (path path-pieces) (url->path (string->url name)))
|
||||||
|
(on-start (log-info "Start observation of ~v" path))
|
||||||
|
(on-stop (log-info "Stop observation of ~v" path))
|
||||||
|
(during (file-content path file->string $data)
|
||||||
|
(assert (api _ (ui-template name data))))))
|
|
@ -0,0 +1,23 @@
|
||||||
|
#lang syndicate
|
||||||
|
|
||||||
|
(require "protocol.rkt")
|
||||||
|
|
||||||
|
(send! (create-resource (account "tonyg@ccs.neu.edu")))
|
||||||
|
(send! (create-resource (account "me@here")))
|
||||||
|
(send! (create-resource (account "also@here")))
|
||||||
|
|
||||||
|
(define (follow! A B)
|
||||||
|
(send! (create-resource (grant A A B (p:follow A) #f)))
|
||||||
|
(send! (create-resource (grant B B A (p:follow B) #f))))
|
||||||
|
|
||||||
|
(follow! "tonyg@ccs.neu.edu" "me@here")
|
||||||
|
(follow! "also@here" "me@here")
|
||||||
|
(follow! "tonyg@ccs.neu.edu" "also@here")
|
||||||
|
|
||||||
|
(define (make-conversation! cid title creator . other-members)
|
||||||
|
(send! (create-resource (conversation cid title creator "")))
|
||||||
|
(for [(who (in-list (cons creator other-members)))]
|
||||||
|
(send! (create-resource (in-conversation cid who)))))
|
||||||
|
|
||||||
|
(make-conversation! "test" "Test Conversation" "tonyg@ccs.neu.edu" "me@here")
|
||||||
|
(make-conversation! "grouptest" "Group Conversation" "also@here" "me@here" "tonyg@ccs.neu.edu")
|
|
@ -0,0 +1,51 @@
|
||||||
|
#lang syndicate
|
||||||
|
|
||||||
|
(require racket/set)
|
||||||
|
|
||||||
|
(require/activate syndicate/reload)
|
||||||
|
(require "protocol.rkt")
|
||||||
|
(require "duplicate.rkt")
|
||||||
|
|
||||||
|
(spawn #:name 'trust-inference
|
||||||
|
(stop-when-reloaded)
|
||||||
|
|
||||||
|
(during (grant $issuer $grantor $grantee $permission $delegable?)
|
||||||
|
(when (equal? issuer grantor)
|
||||||
|
(assert (permitted issuer grantee permission delegable?)))
|
||||||
|
(during (permitted issuer grantor permission #t)
|
||||||
|
(assert (permitted issuer grantee permission delegable?)))))
|
||||||
|
|
||||||
|
(spawn #:name 'grant-factory
|
||||||
|
(stop-when-reloaded)
|
||||||
|
(on (message (create-resource
|
||||||
|
($ g (grant $issuer $grantor $grantee $permission $delegable?))))
|
||||||
|
(spawn #:name g
|
||||||
|
(on-start (log-info "~s grants ~s ~v~a"
|
||||||
|
grantor grantee permission (if delegable? ", delegably" "")))
|
||||||
|
(on-stop (log-info "~s revokes~a grant of ~v to ~s"
|
||||||
|
grantor (if delegable? " delegable" "") permission grantee))
|
||||||
|
(assert g)
|
||||||
|
(stop-when-duplicate g)
|
||||||
|
(stop-when (message (delete-resource g)))
|
||||||
|
(stop-when (message
|
||||||
|
(delete-resource (permitted issuer grantee permission delegable?))))
|
||||||
|
(stop-when (message (delete-resource (account issuer))))
|
||||||
|
(stop-when (message (delete-resource (account grantor))))
|
||||||
|
(stop-when (message (delete-resource (account grantee)))))))
|
||||||
|
|
||||||
|
(spawn #:name 'request-factory
|
||||||
|
(stop-when-reloaded)
|
||||||
|
(on (message (create-resource ($ r (permission-request $the-issuer $grantee $permission))))
|
||||||
|
(spawn #:name r
|
||||||
|
(on-start (log-info "~s requests ~s from ~s" grantee permission the-issuer))
|
||||||
|
(assert r)
|
||||||
|
(stop-when-duplicate r)
|
||||||
|
(stop-when (message (delete-resource r))
|
||||||
|
(log-info "~s's request of ~s from ~s was cancelled or denied"
|
||||||
|
grantee permission the-issuer))
|
||||||
|
(stop-when (asserted (permitted the-issuer grantee permission $delegable?))
|
||||||
|
(log-info "~s's request of ~s from ~s was approved~a"
|
||||||
|
grantee
|
||||||
|
permission
|
||||||
|
the-issuer
|
||||||
|
(if delegable? ", delegably" ""))))))
|
|
@ -0,0 +1,9 @@
|
||||||
|
#lang racket/base
|
||||||
|
|
||||||
|
(provide random-hex-string)
|
||||||
|
|
||||||
|
(require (only-in file/sha1 bytes->hex-string))
|
||||||
|
(require (only-in racket/random crypto-random-bytes))
|
||||||
|
|
||||||
|
(define (random-hex-string half-length)
|
||||||
|
(bytes->hex-string (crypto-random-bytes half-length)))
|
|
@ -39,8 +39,6 @@ route ('<' : nc : s) (Br (os, w, _)) f =
|
||||||
Nothing -> route s (makeTail n w) f
|
Nothing -> route s (makeTail n w) f
|
||||||
route (x : s) (Br (_, w, h)) f = route s (Map.findWithDefault w x h) f
|
route (x : s) (Br (_, w, h)) f = route s (Map.findWithDefault w x h) f
|
||||||
|
|
||||||
get w h x = Map.findWithDefault w x h
|
|
||||||
|
|
||||||
combine f leftEmpty rightEmpty r1 r2 = g r1 r2
|
combine f leftEmpty rightEmpty r1 r2 = g r1 r2
|
||||||
where g (Ok v) r2 = f (Ok v) r2
|
where g (Ok v) r2 = f (Ok v) r2
|
||||||
g r1 (Ok v) = f r1 (Ok v)
|
g r1 (Ok v) = f r1 (Ok v)
|
||||||
|
@ -56,7 +54,7 @@ foldKeys g (Br (os1, w1, h1)) (Br (os2, w2, h2)) =
|
||||||
let o2 = Map.findWithDefault (makeTail size w2) size os2 in
|
let o2 = Map.findWithDefault (makeTail size w2) size os2 in
|
||||||
let o = g o1 o2 in
|
let o = g o1 o2 in
|
||||||
if stripTail size o == Just w then acc else Map.insert size o acc
|
if stripTail size o == Just w then acc else Map.insert size o acc
|
||||||
f x acc = update x (g (get w1 h1 x) (get w2 h2 x)) w acc
|
f x acc = update x (g (Map.findWithDefault w1 x h1) (Map.findWithDefault w2 x h2)) w acc
|
||||||
keys = Set.union (Map.keysSet h1) (Map.keysSet h2)
|
keys = Set.union (Map.keysSet h1) (Map.keysSet h2)
|
||||||
|
|
||||||
collapse (Br (os, Mt, h)) | Map.null os && Map.null h = empty
|
collapse (Br (os, Mt, h)) | Map.null os && Map.null h = empty
|
||||||
|
|
|
@ -55,9 +55,9 @@ function buildActor(nameExpOpt, block, withReact) {
|
||||||
}
|
}
|
||||||
|
|
||||||
function reactWrap(blockCode) {
|
function reactWrap(blockCode) {
|
||||||
return '{ Syndicate.Actor.Facet.build((function () { ' +
|
return '{ Syndicate.Actor.Facet.build(function () { ' +
|
||||||
blockCode +
|
blockCode +
|
||||||
' }).bind(this)); }';
|
' }); }';
|
||||||
}
|
}
|
||||||
|
|
||||||
function buildOnEvent(isTerminal, eventType, subscription, projection, bindings, body) {
|
function buildOnEvent(isTerminal, eventType, subscription, projection, bindings, body) {
|
||||||
|
@ -86,10 +86,10 @@ function buildCaseEvent(eventPattern, body) {
|
||||||
}
|
}
|
||||||
|
|
||||||
var modifiedSourceActions = {
|
var modifiedSourceActions = {
|
||||||
ActorStatement_noReact: function(_actorStar, _namedOpt, nameExpOpt, block) {
|
ActorStatement_noReact: function(_spawnStar, _namedOpt, nameExpOpt, block) {
|
||||||
return buildActor(nameExpOpt, block, false);
|
return buildActor(nameExpOpt, block, false);
|
||||||
},
|
},
|
||||||
ActorStatement_withReact: function(_actor, _namedOpt, nameExpOpt, block) {
|
ActorStatement_withReact: function(_spawn, _namedOpt, nameExpOpt, block) {
|
||||||
return buildActor(nameExpOpt, block, true);
|
return buildActor(nameExpOpt, block, true);
|
||||||
},
|
},
|
||||||
|
|
||||||
|
@ -197,7 +197,7 @@ var modifiedSourceActions = {
|
||||||
[],
|
[],
|
||||||
'{}')) + '}');
|
'{}')) + '}');
|
||||||
},
|
},
|
||||||
ActorEndpointStatement_duringActor: function(_during, pattern, _actor, _named, nameExpOpt, block)
|
ActorEndpointStatement_duringSpawn: function(_during, pattern, _spawn, _named, nameExpOpt, block)
|
||||||
{
|
{
|
||||||
var cachedAssertionVar = gensym('cachedAssertion');
|
var cachedAssertionVar = gensym('cachedAssertion');
|
||||||
var actorBlock = {
|
var actorBlock = {
|
||||||
|
|
|
@ -0,0 +1,59 @@
|
||||||
|
// bin/syndicatec compiler/demo-bad-this.js | node
|
||||||
|
//
|
||||||
|
// Bug with this-ness. Symptomatic output:
|
||||||
|
//
|
||||||
|
// + render one false
|
||||||
|
// + render two false
|
||||||
|
// present one
|
||||||
|
// - render one false
|
||||||
|
// - render two false
|
||||||
|
// + render one one
|
||||||
|
// + render two one
|
||||||
|
//
|
||||||
|
// Good output:
|
||||||
|
//
|
||||||
|
// + render one false
|
||||||
|
// + render two false
|
||||||
|
// present one
|
||||||
|
// - render one false
|
||||||
|
// + render one one
|
||||||
|
|
||||||
|
var Syndicate = require('./src/main.js');
|
||||||
|
|
||||||
|
assertion type user(who);
|
||||||
|
assertion type present(who);
|
||||||
|
assertion type rendered(who, isPresent);
|
||||||
|
|
||||||
|
ground dataspace {
|
||||||
|
spawn {
|
||||||
|
assert user('one');
|
||||||
|
assert present('one');
|
||||||
|
}
|
||||||
|
|
||||||
|
spawn {
|
||||||
|
assert user('two');
|
||||||
|
// assert present('two');
|
||||||
|
}
|
||||||
|
|
||||||
|
spawn {
|
||||||
|
during user($who) {
|
||||||
|
field this.isPresent = false;
|
||||||
|
on asserted present(who) {
|
||||||
|
console.log('present', who);
|
||||||
|
this.isPresent = who;
|
||||||
|
}
|
||||||
|
on retracted present(who) {
|
||||||
|
console.log('absent', who);
|
||||||
|
this.isPresent = false;
|
||||||
|
}
|
||||||
|
assert rendered(who, this.isPresent);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
spawn {
|
||||||
|
during rendered($who, $isPresent) {
|
||||||
|
on start { console.log('+ render', who, isPresent); }
|
||||||
|
on stop { console.log('- render', who, isPresent); }
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
|
@ -6,7 +6,7 @@ assertion type account(balance);
|
||||||
message type deposit(amount);
|
message type deposit(amount);
|
||||||
|
|
||||||
ground dataspace {
|
ground dataspace {
|
||||||
actor {
|
spawn {
|
||||||
field this.balance = 0;
|
field this.balance = 0;
|
||||||
assert account(this.balance);
|
assert account(this.balance);
|
||||||
dataflow {
|
dataflow {
|
||||||
|
@ -17,13 +17,13 @@ ground dataspace {
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
actor {
|
spawn {
|
||||||
on asserted account($balance) {
|
on asserted account($balance) {
|
||||||
console.log("Balance is now", balance);
|
console.log("Balance is now", balance);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
actor {
|
spawn {
|
||||||
on start {
|
on start {
|
||||||
console.log("Waiting for account.");
|
console.log("Waiting for account.");
|
||||||
}
|
}
|
||||||
|
|
|
@ -19,7 +19,7 @@ var Dataspace = Syndicate.Dataspace;
|
||||||
assertion type foo(x, y);
|
assertion type foo(x, y);
|
||||||
|
|
||||||
ground dataspace {
|
ground dataspace {
|
||||||
actor {
|
spawn {
|
||||||
field this.x = 123;
|
field this.x = 123;
|
||||||
|
|
||||||
assert foo(this.x, 999);
|
assert foo(this.x, 999);
|
||||||
|
|
|
@ -22,7 +22,7 @@ ground dataspace {
|
||||||
///////////////////////////////////////////////////////////////////////////
|
///////////////////////////////////////////////////////////////////////////
|
||||||
// The file system actor
|
// The file system actor
|
||||||
|
|
||||||
actor {
|
spawn {
|
||||||
this.files = {};
|
this.files = {};
|
||||||
during Syndicate.observe(file($name, _)) {
|
during Syndicate.observe(file($name, _)) {
|
||||||
on start {
|
on start {
|
||||||
|
@ -44,7 +44,7 @@ ground dataspace {
|
||||||
///////////////////////////////////////////////////////////////////////////
|
///////////////////////////////////////////////////////////////////////////
|
||||||
// A simple demo client of the file system
|
// A simple demo client of the file system
|
||||||
|
|
||||||
actor {
|
spawn {
|
||||||
on asserted file("hello.txt", $content) {
|
on asserted file("hello.txt", $content) {
|
||||||
console.log("hello.txt has content", JSON.stringify(content));
|
console.log("hello.txt has content", JSON.stringify(content));
|
||||||
}
|
}
|
||||||
|
@ -54,14 +54,14 @@ ground dataspace {
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
actor {
|
spawn {
|
||||||
stop on asserted Syndicate.observe(saveFile(_, _)) {
|
stop on asserted Syndicate.observe(saveFile(_, _)) {
|
||||||
:: saveFile("hello.txt", "a");
|
:: saveFile("hello.txt", "a");
|
||||||
:: deleteFile("hello.txt");
|
:: deleteFile("hello.txt");
|
||||||
:: saveFile("hello.txt", "c");
|
:: saveFile("hello.txt", "c");
|
||||||
:: saveFile("hello.txt", "quit demo");
|
:: saveFile("hello.txt", "quit demo");
|
||||||
:: saveFile("hello.txt", "final contents");
|
:: saveFile("hello.txt", "final contents");
|
||||||
actor {
|
spawn {
|
||||||
stop on asserted file("hello.txt", $content) {
|
stop on asserted file("hello.txt", $content) {
|
||||||
console.log("second observer sees that hello.txt content is",
|
console.log("second observer sees that hello.txt content is",
|
||||||
JSON.stringify(content));
|
JSON.stringify(content));
|
||||||
|
|
|
@ -59,7 +59,7 @@ assertion type show();
|
||||||
assertion type view(str);
|
assertion type view(str);
|
||||||
|
|
||||||
ground dataspace {
|
ground dataspace {
|
||||||
actor {
|
spawn {
|
||||||
field this.title = "first";
|
field this.title = "first";
|
||||||
assert todo(this.title);
|
assert todo(this.title);
|
||||||
on message 3 {
|
on message 3 {
|
||||||
|
@ -67,11 +67,11 @@ ground dataspace {
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
actor {
|
spawn {
|
||||||
assert show();
|
assert show();
|
||||||
}
|
}
|
||||||
|
|
||||||
actor {
|
spawn {
|
||||||
field this.editing = false;
|
field this.editing = false;
|
||||||
|
|
||||||
during todo($title) {
|
during todo($title) {
|
||||||
|
@ -95,14 +95,14 @@ ground dataspace {
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
actor {
|
spawn {
|
||||||
on start { :: 0; }
|
on start { :: 0; }
|
||||||
stop on message 0 {
|
stop on message 0 {
|
||||||
:: 1;
|
:: 1;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
actor {
|
spawn {
|
||||||
field this.count = 0;
|
field this.count = 0;
|
||||||
on retracted view($x) { console.log('VIEW--', x); }
|
on retracted view($x) { console.log('VIEW--', x); }
|
||||||
on asserted view($x) {
|
on asserted view($x) {
|
||||||
|
|
|
@ -14,7 +14,7 @@ assertion type ready(what);
|
||||||
assertion type entry(key, val);
|
assertion type entry(key, val);
|
||||||
|
|
||||||
ground dataspace {
|
ground dataspace {
|
||||||
actor named 'listener' {
|
spawn named 'listener' {
|
||||||
assert ready('listener');
|
assert ready('listener');
|
||||||
on asserted entry($key, _) {
|
on asserted entry($key, _) {
|
||||||
console.log('key asserted', key);
|
console.log('key asserted', key);
|
||||||
|
@ -28,7 +28,7 @@ ground dataspace {
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
actor named 'other-listener' {
|
spawn named 'other-listener' {
|
||||||
assert ready('other-listener');
|
assert ready('other-listener');
|
||||||
during entry($key, _) {
|
during entry($key, _) {
|
||||||
on start { console.log('(other-listener) key asserted', key); }
|
on start { console.log('(other-listener) key asserted', key); }
|
||||||
|
@ -50,7 +50,7 @@ ground dataspace {
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
actor named 'driver' {
|
spawn named 'driver' {
|
||||||
stop on asserted ready('listener') {
|
stop on asserted ready('listener') {
|
||||||
react {
|
react {
|
||||||
stop on asserted ready('other-listener') {
|
stop on asserted ready('other-listener') {
|
||||||
|
|
|
@ -0,0 +1,55 @@
|
||||||
|
// bin/syndicatec compiler/demo-synthetic-patch-2.js | node
|
||||||
|
//
|
||||||
|
// Analogous example to syndicate/racket/syndicate/examples/actor/example-synthetic-patch-2.rkt.
|
||||||
|
//
|
||||||
|
// Symptomatic output:
|
||||||
|
//
|
||||||
|
// Outer value 4 = 4
|
||||||
|
// Value 0 = 0
|
||||||
|
// Value 1 = 1
|
||||||
|
// Value 2 = 2
|
||||||
|
// Value 3 = 3
|
||||||
|
//
|
||||||
|
// Correct output:
|
||||||
|
//
|
||||||
|
// Outer value 4 = 4
|
||||||
|
// Value 0 = 0
|
||||||
|
// Value 1 = 1
|
||||||
|
// Value 2 = 2
|
||||||
|
// Value 3 = 3
|
||||||
|
// Value 4 = 4
|
||||||
|
// Value 5 = 5
|
||||||
|
|
||||||
|
var Syndicate = require('./src/main.js');
|
||||||
|
|
||||||
|
assertion type mapping(key, value);
|
||||||
|
assertion type ready();
|
||||||
|
|
||||||
|
ground dataspace {
|
||||||
|
spawn {
|
||||||
|
field this.ofInterest = 0;
|
||||||
|
during ready() {
|
||||||
|
on asserted mapping(this.ofInterest, $v) {
|
||||||
|
console.log("Value", this.ofInterest, "=", v);
|
||||||
|
this.ofInterest += 1;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
on asserted mapping(4, $v) {
|
||||||
|
console.log("Outer value", 4, "=", v);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
spawn {
|
||||||
|
assert mapping(0, 0);
|
||||||
|
assert mapping(1, 1);
|
||||||
|
assert mapping(2, 2);
|
||||||
|
assert mapping(3, 3);
|
||||||
|
assert mapping(4, 4);
|
||||||
|
assert mapping(5, 5);
|
||||||
|
on start {
|
||||||
|
react {
|
||||||
|
assert ready();
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
|
@ -18,8 +18,8 @@ Syndicate <: ES5 {
|
||||||
FunctionBodyBlock = "{" FunctionBody "}" // odd that this isn't in es5.ohm somewhere
|
FunctionBodyBlock = "{" FunctionBody "}" // odd that this isn't in es5.ohm somewhere
|
||||||
|
|
||||||
ActorStatement
|
ActorStatement
|
||||||
= actorStar (named Expression<withIn>)? FunctionBodyBlock -- noReact
|
= spawnStar (named Expression<withIn>)? FunctionBodyBlock -- noReact
|
||||||
| actor (named Expression<withIn>)? FunctionBodyBlock -- withReact
|
| spawn (named Expression<withIn>)? FunctionBodyBlock -- withReact
|
||||||
|
|
||||||
DataspaceStatement
|
DataspaceStatement
|
||||||
= ground dataspace identifier? FunctionBodyBlock -- ground
|
= ground dataspace identifier? FunctionBodyBlock -- ground
|
||||||
|
@ -38,7 +38,7 @@ Syndicate <: ES5 {
|
||||||
| stop on FacetTransitionEventPattern #(sc) -- stopOnNoCont
|
| stop on FacetTransitionEventPattern #(sc) -- stopOnNoCont
|
||||||
| dataflow FunctionBodyBlock -- dataflow
|
| dataflow FunctionBodyBlock -- dataflow
|
||||||
| during FacetPattern FunctionBodyBlock -- during
|
| during FacetPattern FunctionBodyBlock -- during
|
||||||
| during FacetPattern actor (named Expression<withIn>)? FunctionBodyBlock -- duringActor
|
| during FacetPattern spawn (named Expression<withIn>)? FunctionBodyBlock -- duringSpawn
|
||||||
|
|
||||||
AssertWhenClause = when "(" Expression<withIn> ")"
|
AssertWhenClause = when "(" Expression<withIn> ")"
|
||||||
|
|
||||||
|
@ -69,8 +69,8 @@ Syndicate <: ES5 {
|
||||||
// we don't want to make them unavailable to programs as
|
// we don't want to make them unavailable to programs as
|
||||||
// identifiers.
|
// identifiers.
|
||||||
|
|
||||||
actorStar = "actor*" ~identifierPart
|
spawnStar = "spawn*" ~identifierPart
|
||||||
actor = "actor" ~("*" | identifierPart)
|
spawn = "spawn" ~("*" | identifierPart)
|
||||||
assert = "assert" ~identifierPart
|
assert = "assert" ~identifierPart
|
||||||
asserted = "asserted" ~identifierPart
|
asserted = "asserted" ~identifierPart
|
||||||
assertion = "assertion" ~identifierPart
|
assertion = "assertion" ~identifierPart
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
ground dataspace {
|
ground dataspace {
|
||||||
Syndicate.UI.spawnUIDriver();
|
Syndicate.UI.spawnUIDriver();
|
||||||
|
|
||||||
actor {
|
spawn {
|
||||||
var ui = new Syndicate.UI.Anchor();
|
var ui = new Syndicate.UI.Anchor();
|
||||||
field this.counter = 0;
|
field this.counter = 0;
|
||||||
assert ui.html('#button-label', '' + this.counter);
|
assert ui.html('#button-label', '' + this.counter);
|
||||||
|
|
|
@ -15,7 +15,7 @@ function spawnChatApp() {
|
||||||
$("#nym_form").submit(function (e) { e.preventDefault(); return false; });
|
$("#nym_form").submit(function (e) { e.preventDefault(); return false; });
|
||||||
if (!($("#nym").val())) { $("#nym").val("nym" + Math.floor(Math.random() * 65536)); }
|
if (!($("#nym").val())) { $("#nym").val("nym" + Math.floor(Math.random() * 65536)); }
|
||||||
|
|
||||||
actor {
|
spawn {
|
||||||
var ui = new Syndicate.UI.Anchor();
|
var ui = new Syndicate.UI.Anchor();
|
||||||
field this.nym;
|
field this.nym;
|
||||||
field this.status;
|
field this.status;
|
||||||
|
@ -82,8 +82,8 @@ function outputUtterance(who, what) {
|
||||||
assertion type inputValue(selector, value);
|
assertion type inputValue(selector, value);
|
||||||
|
|
||||||
function spawnInputChangeMonitor() {
|
function spawnInputChangeMonitor() {
|
||||||
actor {
|
spawn {
|
||||||
during Syndicate.observe(inputValue($selector, _)) actor {
|
during Syndicate.observe(inputValue($selector, _)) spawn {
|
||||||
field this.value = $(selector).val();
|
field this.value = $(selector).val();
|
||||||
assert inputValue(selector, this.value);
|
assert inputValue(selector, this.value);
|
||||||
on message Syndicate.UI.globalEvent(selector, 'change', $e) {
|
on message Syndicate.UI.globalEvent(selector, 'change', $e) {
|
||||||
|
|
|
@ -0,0 +1,7 @@
|
||||||
|
all: index.expanded.js worker.expanded.js
|
||||||
|
|
||||||
|
%.expanded.js: %.js
|
||||||
|
../../bin/syndicatec $< > $@ || (rm -f $@; false)
|
||||||
|
|
||||||
|
clean:
|
||||||
|
rm -f *.expanded.js
|
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue