Artifact
36a62e8b5dfb369b7d8629b17229ad5ef088224d
File
net2o-connect.fs
— part of check-in
[5c3be525ad]
at
2015-12-13 23:58:44
on branch trunk
— Add plugin for cookie-done reaction
(user:
bernd
size: 6443)
0000: 5c 20 6e 65 74 32 6f 20 63 6f 6e 6e 65 63 74 69 \ net2o connecti
0010: 6f 6e 20 73 65 74 75 70 20 63 6f 6d 6d 61 6e 64 on setup command
0020: 73 0a 0a 5c 20 43 6f 70 79 72 69 67 68 74 20 28 s..\ Copyright (
0030: 43 29 20 32 30 31 31 2d 32 30 31 34 20 20 20 42 C) 2011-2014 B
0040: 65 72 6e 64 20 50 61 79 73 61 6e 0a 0a 5c 20 54 ernd Paysan..\ T
0050: 68 69 73 20 70 72 6f 67 72 61 6d 20 69 73 20 66 his program is f
0060: 72 65 65 20 73 6f 66 74 77 61 72 65 3a 20 79 6f ree software: yo
0070: 75 20 63 61 6e 20 72 65 64 69 73 74 72 69 62 75 u can redistribu
0080: 74 65 20 69 74 20 61 6e 64 2f 6f 72 20 6d 6f 64 te it and/or mod
0090: 69 66 79 0a 5c 20 69 74 20 75 6e 64 65 72 20 74 ify.\ it under t
00a0: 68 65 20 74 65 72 6d 73 20 6f 66 20 74 68 65 20 he terms of the
00b0: 47 4e 55 20 41 66 66 65 72 6f 20 47 65 6e 65 72 GNU Affero Gener
00c0: 61 6c 20 50 75 62 6c 69 63 20 4c 69 63 65 6e 73 al Public Licens
00d0: 65 20 61 73 20 70 75 62 6c 69 73 68 65 64 20 62 e as published b
00e0: 79 0a 5c 20 74 68 65 20 46 72 65 65 20 53 6f 66 y.\ the Free Sof
00f0: 74 77 61 72 65 20 46 6f 75 6e 64 61 74 69 6f 6e tware Foundation
0100: 2c 20 65 69 74 68 65 72 20 76 65 72 73 69 6f 6e , either version
0110: 20 33 20 6f 66 20 74 68 65 20 4c 69 63 65 6e 73 3 of the Licens
0120: 65 2c 20 6f 72 0a 5c 20 28 61 74 20 79 6f 75 72 e, or.\ (at your
0130: 20 6f 70 74 69 6f 6e 29 20 61 6e 79 20 6c 61 74 option) any lat
0140: 65 72 20 76 65 72 73 69 6f 6e 2e 0a 0a 5c 20 54 er version...\ T
0150: 68 69 73 20 70 72 6f 67 72 61 6d 20 69 73 20 64 his program is d
0160: 69 73 74 72 69 62 75 74 65 64 20 69 6e 20 74 68 istributed in th
0170: 65 20 68 6f 70 65 20 74 68 61 74 20 69 74 20 77 e hope that it w
0180: 69 6c 6c 20 62 65 20 75 73 65 66 75 6c 2c 0a 5c ill be useful,.\
0190: 20 62 75 74 20 57 49 54 48 4f 55 54 20 41 4e 59 but WITHOUT ANY
01a0: 20 57 41 52 52 41 4e 54 59 3b 20 77 69 74 68 6f WARRANTY; witho
01b0: 75 74 20 65 76 65 6e 20 74 68 65 20 69 6d 70 6c ut even the impl
01c0: 69 65 64 20 77 61 72 72 61 6e 74 79 20 6f 66 0a ied warranty of.
01d0: 5c 20 4d 45 52 43 48 41 4e 54 41 42 49 4c 49 54 \ MERCHANTABILIT
01e0: 59 20 6f 72 20 46 49 54 4e 45 53 53 20 46 4f 52 Y or FITNESS FOR
01f0: 20 41 20 50 41 52 54 49 43 55 4c 41 52 20 50 55 A PARTICULAR PU
0200: 52 50 4f 53 45 2e 20 20 53 65 65 20 74 68 65 0a RPOSE. See the.
0210: 5c 20 47 4e 55 20 41 66 66 65 72 6f 20 47 65 6e \ GNU Affero Gen
0220: 65 72 61 6c 20 50 75 62 6c 69 63 20 4c 69 63 65 eral Public Lice
0230: 6e 73 65 20 66 6f 72 20 6d 6f 72 65 20 64 65 74 nse for more det
0240: 61 69 6c 73 2e 0a 0a 5c 20 59 6f 75 20 73 68 6f ails...\ You sho
0250: 75 6c 64 20 68 61 76 65 20 72 65 63 65 69 76 65 uld have receive
0260: 64 20 61 20 63 6f 70 79 20 6f 66 20 74 68 65 20 d a copy of the
0270: 47 4e 55 20 41 66 66 65 72 6f 20 47 65 6e 65 72 GNU Affero Gener
0280: 61 6c 20 50 75 62 6c 69 63 20 4c 69 63 65 6e 73 al Public Licens
0290: 65 0a 5c 20 61 6c 6f 6e 67 20 77 69 74 68 20 74 e.\ along with t
02a0: 68 69 73 20 70 72 6f 67 72 61 6d 2e 20 20 49 66 his program. If
02b0: 20 6e 6f 74 2c 20 73 65 65 20 3c 68 74 74 70 3a not, see <http:
02c0: 2f 2f 77 77 77 2e 67 6e 75 2e 6f 72 67 2f 6c 69 //www.gnu.org/li
02d0: 63 65 6e 73 65 73 2f 3e 2e 0a 0a 44 65 66 65 72 censes/>...Defer
02e0: 20 3e 69 6e 76 69 74 61 74 69 6f 6e 73 0a 0a 73 >invitations..s
02f0: 63 6f 70 65 7b 20 6e 65 74 32 6f 2d 62 61 73 65 cope{ net2o-base
0300: 0a 0a 72 65 70 6c 79 2d 74 61 62 6c 65 20 24 40 ..reply-table $@
0310: 20 69 6e 68 65 72 69 74 2d 74 61 62 6c 65 20 73 inherit-table s
0320: 65 74 75 70 2d 74 61 62 6c 65 0a 0a 5c 67 20 0a etup-table..\g .
0330: 5c 67 20 23 23 23 20 63 6f 6e 6e 65 63 74 69 6f \g ### connectio
0340: 6e 20 73 65 74 75 70 20 63 6f 6d 6d 61 6e 64 73 n setup commands
0350: 20 23 23 23 0a 5c 67 20 0a 0a 24 32 30 20 6e 65 ###.\g ..$20 ne
0360: 74 32 6f 3a 20 74 6d 70 6e 65 73 74 20 28 20 24 t2o: tmpnest ( $
0370: 3a 73 74 72 69 6e 67 20 2d 2d 20 29 20 5c 67 20 :string -- ) \g
0380: 6e 65 73 74 65 64 20 28 74 65 6d 70 6f 72 61 72 nested (temporar
0390: 79 20 65 6e 63 72 79 70 74 65 64 29 20 63 6f 6d y encrypted) com
03a0: 6d 61 6e 64 0a 20 20 20 20 24 3e 20 63 6d 64 74 mand. $> cmdt
03b0: 6d 70 6e 65 73 74 20 3b 0a 0a 3a 20 5d 74 6d 70 mpnest ;..: ]tmp
03c0: 6e 65 73 74 20 28 20 2d 2d 20 29 20 20 65 6e 64 nest ( -- ) end
03d0: 2d 63 6d 64 20 63 6d 64 3e 74 6d 70 6e 65 73 74 -cmd cmd>tmpnest
03e0: 20 32 64 72 6f 70 20 74 6d 70 6e 65 73 74 20 3b 2drop tmpnest ;
03f0: 0a 0a 2b 6e 65 74 32 6f 3a 20 6e 65 77 2d 64 61 ..+net2o: new-da
0400: 74 61 20 28 20 61 64 64 72 20 61 64 64 72 20 75 ta ( addr addr u
0410: 20 2d 2d 20 29 20 5c 67 20 63 72 65 61 74 65 20 -- ) \g create
0420: 6e 65 77 20 64 61 74 61 20 6d 61 70 70 69 6e 67 new data mapping
0430: 0a 20 20 20 20 6f 20 30 3c 3e 20 74 6d 70 2d 63 . o 0<> tmp-c
0440: 72 79 70 74 3f 20 61 6e 64 20 6f 77 6e 2d 63 72 rypt? and own-cr
0450: 79 70 74 3f 20 6f 72 20 49 46 20 20 36 34 3e 6e ypt? or IF 64>n
0460: 20 20 6e 32 6f 3a 6e 65 77 2d 64 61 74 61 20 20 n2o:new-data
0470: 45 58 49 54 20 20 54 48 45 4e 0a 20 20 20 20 36 EXIT THEN. 6
0480: 34 64 72 6f 70 20 36 34 64 72 6f 70 20 36 34 64 4drop 64drop 64d
0490: 72 6f 70 20 20 75 6e 2d 63 6d 64 20 3b 0a 2b 6e rop un-cmd ;.+n
04a0: 65 74 32 6f 3a 20 6e 65 77 2d 63 6f 64 65 20 28 et2o: new-code (
04b0: 20 61 64 64 72 20 61 64 64 72 20 75 20 2d 2d 20 addr addr u --
04c0: 29 20 5c 67 20 63 72 61 74 65 20 6e 65 77 20 63 ) \g crate new c
04d0: 6f 64 65 20 6d 61 70 70 69 6e 67 0a 20 20 20 20 ode mapping.
04e0: 6f 20 30 3c 3e 20 74 6d 70 2d 63 72 79 70 74 3f o 0<> tmp-crypt?
04f0: 20 61 6e 64 20 6f 77 6e 2d 63 72 79 70 74 3f 20 and own-crypt?
0500: 6f 72 20 49 46 20 20 36 34 3e 6e 20 20 6e 32 6f or IF 64>n n2o
0510: 3a 6e 65 77 2d 63 6f 64 65 20 20 45 58 49 54 20 :new-code EXIT
0520: 20 54 48 45 4e 0a 20 20 20 20 36 34 64 72 6f 70 THEN. 64drop
0530: 20 36 34 64 72 6f 70 20 36 34 64 72 6f 70 20 20 64drop 64drop
0540: 75 6e 2d 63 6d 64 20 3b 0a 0a 3a 20 6e 32 6f 3a un-cmd ;..: n2o:
0550: 63 72 65 61 74 65 2d 6d 61 70 0a 20 20 20 20 7b create-map. {
0560: 20 36 34 3a 20 61 64 64 72 73 20 75 63 6f 64 65 64: addrs ucode
0570: 20 75 64 61 74 61 20 36 34 3a 20 61 64 64 72 64 udata 64: addrd
0580: 20 2d 2d 20 61 64 64 72 64 20 75 63 6f 64 65 20 -- addrd ucode
0590: 75 64 61 74 61 20 61 64 64 72 73 20 7d 0a 20 20 udata addrs }.
05a0: 20 20 61 64 64 72 73 20 6c 69 74 2c 20 61 64 64 addrs lit, add
05b0: 72 64 20 6c 69 74 2c 20 75 63 6f 64 65 20 75 6c rd lit, ucode ul
05c0: 69 74 2c 20 6e 65 77 2d 63 6f 64 65 0a 20 20 20 it, new-code.
05d0: 20 61 64 64 72 73 20 6d 69 6e 2d 73 69 7a 65 20 addrs min-size
05e0: 75 63 6f 64 65 20 6c 73 68 69 66 74 20 6e 3e 36 ucode lshift n>6
05f0: 34 20 36 34 2b 20 6c 69 74 2c 0a 20 20 20 20 61 4 64+ lit,. a
0600: 64 64 72 64 20 6d 69 6e 2d 73 69 7a 65 20 75 63 ddrd min-size uc
0610: 6f 64 65 20 6c 73 68 69 66 74 20 6e 3e 36 34 20 ode lshift n>64
0620: 36 34 2b 20 6c 69 74 2c 20 75 64 61 74 61 20 75 64+ lit, udata u
0630: 6c 69 74 2c 20 6e 65 77 2d 64 61 74 61 0a 20 20 lit, new-data.
0640: 20 20 61 64 64 72 64 20 75 63 6f 64 65 20 75 64 addrd ucode ud
0650: 61 74 61 20 61 64 64 72 73 20 3b 0a 0a 2b 6e 65 ata addrs ;..+ne
0660: 74 32 6f 3a 20 73 74 6f 72 65 2d 6b 65 79 20 28 t2o: store-key (
0670: 20 24 3a 73 74 72 69 6e 67 20 2d 2d 20 29 20 24 $:string -- ) $
0680: 3e 20 5c 67 20 73 74 6f 72 65 20 6b 65 79 0a 20 > \g store key.
0690: 20 20 20 6f 20 30 3d 20 49 46 20 20 32 64 72 6f o 0= IF 2dro
06a0: 70 20 75 6e 2d 63 6d 64 20 20 45 58 49 54 20 20 p un-cmd EXIT
06b0: 54 48 45 4e 0a 20 20 20 20 6f 77 6e 2d 63 72 79 THEN. own-cry
06c0: 70 74 3f 20 49 46 0a 09 6b 65 79 28 20 2e 22 20 pt? IF..key( ."
06d0: 73 74 6f 72 65 20 6b 65 79 3a 20 6f 3d 22 20 6f store key: o=" o
06e0: 20 68 65 78 2e 20 32 64 75 70 20 2e 6e 6e 62 20 hex. 2dup .nnb
06f0: 66 6f 72 74 68 3a 63 72 20 29 0a 09 32 64 75 70 forth:cr )..2dup
0700: 20 64 6f 2d 6b 65 79 70 61 64 20 73 65 63 21 0a do-keypad sec!.
0710: 09 63 72 79 70 74 6f 2d 6b 65 79 20 73 65 63 21 .crypto-key sec!
0720: 0a 20 20 20 20 45 4c 53 45 20 20 32 64 72 6f 70 . ELSE 2drop
0730: 20 75 6e 2d 63 6d 64 20 20 54 48 45 4e 20 3b 0a un-cmd THEN ;.
0740: 0a 2b 6e 65 74 32 6f 3a 20 6d 61 70 2d 72 65 71 .+net2o: map-req
0750: 75 65 73 74 20 28 20 61 64 64 72 73 20 75 63 6f uest ( addrs uco
0760: 64 65 20 75 64 61 74 61 20 2d 2d 20 29 20 5c 67 de udata -- ) \g
0770: 20 72 65 71 75 65 73 74 20 6d 61 70 70 69 6e 67 request mapping
0780: 0a 20 20 20 20 32 2a 36 34 3e 6e 0a 20 20 20 20 . 2*64>n.
0790: 6e 65 73 74 5b 0a 20 20 20 20 3f 6e 65 77 2d 6d nest[. ?new-m
07a0: 79 6b 65 79 20 20 74 69 63 6b 65 72 20 36 34 40 ykey ticker 64@
07b0: 20 6c 69 74 2c 20 73 65 74 2d 63 6f 6f 6b 69 65 lit, set-cookie
07c0: 0a 20 20 20 20 6d 61 78 2d 64 61 74 61 23 20 75 . max-data# u
07d0: 6d 69 6e 20 73 77 61 70 20 6d 61 78 2d 63 6f 64 min swap max-cod
07e0: 65 23 20 75 6d 69 6e 20 73 77 61 70 0a 20 20 20 e# umin swap.
07f0: 20 32 64 75 70 20 2b 20 6e 32 6f 3a 6e 65 77 2d 2dup + n2o:new-
0800: 6d 61 70 20 6e 32 6f 3a 63 72 65 61 74 65 2d 6d map n2o:create-m
0810: 61 70 0a 20 20 20 20 6b 65 79 70 61 64 20 6b 65 ap. keypad ke
0820: 79 73 69 7a 65 20 73 65 63 24 2c 20 73 74 6f 72 ysize sec$, stor
0830: 65 2d 6b 65 79 20 20 73 74 73 6b 63 20 4b 45 59 e-key stskc KEY
0840: 53 49 5a 45 20 65 72 61 73 65 0a 20 20 20 20 5d SIZE erase. ]
0850: 6e 65 73 74 20 20 6e 32 6f 3a 63 72 65 61 74 65 nest n2o:create
0860: 2d 6d 61 70 20 20 6e 65 73 74 2d 73 74 61 63 6b -map nest-stack
0870: 20 24 5b 5d 23 20 49 46 20 20 5d 74 6d 70 6e 65 $[]# IF ]tmpne
0880: 73 74 20 20 54 48 45 4e 0a 20 20 20 20 36 34 64 st THEN. 64d
0890: 72 6f 70 20 32 64 72 6f 70 20 36 34 64 72 6f 70 rop 2drop 64drop
08a0: 20 3b 0a 0a 2b 6e 65 74 32 6f 3a 20 73 65 74 2d ;..+net2o: set-
08b0: 74 69 63 6b 20 28 20 75 74 69 63 6b 73 20 2d 2d tick ( uticks --
08c0: 20 29 20 5c 67 20 61 64 6a 75 73 74 20 74 69 6d ) \g adjust tim
08d0: 65 0a 20 20 20 20 6f 20 49 46 0a 09 61 64 6a 75 e. o IF..adju
08e0: 73 74 2d 74 69 6d 65 72 28 20 2e 22 20 61 64 6a st-timer( ." adj
08f0: 75 73 74 20 74 69 6d 65 72 22 20 66 6f 72 74 68 ust timer" forth
0900: 3a 63 72 20 29 0a 09 61 63 6b 40 20 2e 61 64 6a :cr )..ack@ .adj
0910: 75 73 74 2d 74 69 63 6b 73 0a 20 20 20 20 45 4c ust-ticks. EL
0920: 53 45 0a 09 61 64 6a 75 73 74 2d 74 69 6d 65 72 SE..adjust-timer
0930: 28 20 2e 22 20 6e 6f 20 6f 62 6a 65 63 74 3a 20 ( ." no object:
0940: 64 6f 6e 27 74 20 61 64 6a 75 73 74 20 74 69 6d don't adjust tim
0950: 65 72 20 22 20 6f 20 68 65 78 2e 20 66 6f 72 74 er " o hex. fort
0960: 68 3a 63 72 20 29 0a 09 36 34 64 72 6f 70 0a 20 h:cr )..64drop.
0970: 20 20 20 54 48 45 4e 20 3b 0a 2b 6e 65 74 32 6f THEN ;.+net2o
0980: 3a 20 67 65 74 2d 74 69 63 6b 20 28 20 2d 2d 20 : get-tick ( --
0990: 29 20 5c 67 20 72 65 71 75 65 73 74 20 74 69 6d ) \g request tim
09a0: 65 20 61 64 6a 75 73 74 0a 20 20 20 20 74 69 63 e adjust. tic
09b0: 6b 73 20 6c 69 74 2c 20 73 65 74 2d 74 69 63 6b ks lit, set-tick
09c0: 20 3b 0a 0a 6e 65 74 32 6f 2d 62 61 73 65 0a 0a ;..net2o-base..
09d0: 5c 20 63 72 79 70 74 6f 20 66 75 6e 63 74 69 6f \ crypto functio
09e0: 6e 73 0a 0a 2b 6e 65 74 32 6f 3a 20 72 65 63 65 ns..+net2o: rece
09f0: 69 76 65 2d 6b 65 79 20 28 20 24 3a 6b 65 79 20 ive-key ( $:key
0a00: 2d 2d 20 29 20 24 3e 20 5c 67 20 72 65 63 65 69 -- ) $> \g recei
0a10: 76 65 20 61 20 6b 65 79 0a 20 20 20 20 63 72 79 ve a key. cry
0a20: 70 74 28 20 2e 22 20 52 65 63 65 69 76 65 64 20 pt( ." Received
0a30: 6b 65 79 3a 20 22 20 74 6d 70 6b 65 79 40 20 2e key: " tmpkey@ .
0a40: 6e 6e 62 20 66 6f 72 74 68 3a 63 72 20 29 0a 20 nnb forth:cr ).
0a50: 20 20 20 74 6d 70 2d 63 72 79 70 74 3f 20 49 46 tmp-crypt? IF
0a60: 20 20 6e 65 74 32 6f 3a 72 65 63 65 69 76 65 2d net2o:receive-
0a70: 6b 65 79 20 20 45 4c 53 45 20 20 32 64 72 6f 70 key ELSE 2drop
0a80: 20 20 54 48 45 4e 20 3b 0a 2b 6e 65 74 32 6f 3a THEN ;.+net2o:
0a90: 20 72 65 63 65 69 76 65 2d 74 6d 70 6b 65 79 20 receive-tmpkey
0aa0: 28 20 24 3a 6b 65 79 20 2d 2d 20 29 20 24 3e 20 ( $:key -- ) $>
0ab0: 5c 67 20 72 65 63 65 69 76 65 20 65 6d 70 68 65 \g receive emphe
0ac0: 6d 65 72 61 6c 20 6b 65 79 0a 20 20 20 20 6e 65 meral key. ne
0ad0: 74 32 6f 3a 72 65 63 65 69 76 65 2d 74 6d 70 6b t2o:receive-tmpk
0ae0: 65 79 20 3b 0a 2b 6e 65 74 32 6f 3a 20 6b 65 79 ey ;.+net2o: key
0af0: 2d 72 65 71 75 65 73 74 20 28 20 2d 2d 20 29 20 -request ( -- )
0b00: 5c 67 20 72 65 71 75 65 73 74 20 61 20 6b 65 79 \g request a key
0b10: 0a 20 20 20 20 63 72 79 70 74 28 20 2e 22 20 4e . crypt( ." N
0b20: 65 73 74 65 64 20 6b 65 79 3a 20 22 20 74 6d 70 ested key: " tmp
0b30: 6b 65 79 40 20 2e 6e 6e 62 20 66 6f 72 74 68 3a key@ .nnb forth:
0b40: 63 72 20 29 0a 20 20 20 20 70 6b 63 20 6b 65 79 cr ). pkc key
0b50: 73 69 7a 65 20 24 2c 20 72 65 63 65 69 76 65 2d size $, receive-
0b60: 6b 65 79 20 3b 0a 2b 6e 65 74 32 6f 3a 20 74 6d key ;.+net2o: tm
0b70: 70 6b 65 79 2d 72 65 71 75 65 73 74 20 28 20 2d pkey-request ( -
0b80: 2d 20 29 20 5c 67 20 72 65 71 75 65 73 74 20 65 - ) \g request e
0b90: 70 68 65 6d 65 72 61 6c 20 6b 65 79 0a 20 20 20 phemeral key.
0ba0: 20 73 74 70 6b 63 20 6b 65 79 73 69 7a 65 20 24 stpkc keysize $
0bb0: 2c 20 72 65 63 65 69 76 65 2d 74 6d 70 6b 65 79 , receive-tmpkey
0bc0: 20 6e 65 73 74 5b 20 3b 0a 2b 6e 65 74 32 6f 3a nest[ ;.+net2o:
0bd0: 20 6b 65 79 70 61 69 72 20 28 20 24 3a 79 6f 75 keypair ( $:you
0be0: 72 6b 65 79 20 24 3a 6d 79 6b 65 79 20 2d 2d 20 rkey $:mykey --
0bf0: 29 20 5c 67 20 73 65 6c 65 63 74 20 61 20 70 75 ) \g select a pu
0c00: 62 6b 65 79 0a 20 20 20 20 24 3e 20 24 3e 20 74 bkey. $> $> t
0c10: 6d 70 2d 63 72 79 70 74 3f 20 49 46 20 20 32 73 mp-crypt? IF 2s
0c20: 77 61 70 20 6e 65 74 32 6f 3a 6b 65 79 70 61 69 wap net2o:keypai
0c30: 72 20 20 45 4c 53 45 20 20 32 64 72 6f 70 20 32 r ELSE 2drop 2
0c40: 64 72 6f 70 20 20 54 48 45 4e 20 3b 0a 2b 6e 65 drop THEN ;.+ne
0c50: 74 32 6f 3a 20 75 70 64 61 74 65 2d 6b 65 79 20 t2o: update-key
0c60: 28 20 2d 2d 20 29 20 5c 67 20 75 70 64 61 74 65 ( -- ) \g update
0c70: 20 73 65 63 72 65 74 73 0a 20 20 20 20 6e 65 74 secrets. net
0c80: 32 6f 3a 75 70 64 61 74 65 2d 6b 65 79 20 3b 0a 2o:update-key ;.
0c90: 2b 6e 65 74 32 6f 3a 20 67 65 6e 2d 69 76 73 20 +net2o: gen-ivs
0ca0: 28 20 24 3a 73 74 72 69 6e 67 20 2d 2d 20 29 20 ( $:string -- )
0cb0: 5c 67 20 67 65 6e 65 72 61 74 65 20 49 56 73 0a \g generate IVs.
0cc0: 20 20 20 20 24 3e 20 69 76 73 2d 73 74 72 69 6e $> ivs-strin
0cd0: 67 73 20 72 65 63 65 69 76 65 2d 69 76 73 20 3b gs receive-ivs ;
0ce0: 0a 0a 5c 20 6e 61 74 20 74 72 61 76 65 72 73 61 ..\ nat traversa
0cf0: 6c 20 66 75 6e 63 74 69 6f 6e 73 0a 0a 2b 6e 65 l functions..+ne
0d00: 74 32 6f 3a 20 70 75 6e 63 68 20 28 20 24 3a 73 t2o: punch ( $:s
0d10: 74 72 69 6e 67 20 2d 2d 20 29 20 5c 67 20 70 75 tring -- ) \g pu
0d20: 6e 63 68 20 4e 41 54 20 74 72 61 76 65 72 73 61 nch NAT traversa
0d30: 6c 20 68 6f 6c 65 0a 20 20 20 20 24 3e 20 62 75 l hole. $> bu
0d40: 66 2d 73 74 61 74 65 20 32 40 20 32 3e 72 20 6e f-state 2@ 2>r n
0d50: 65 74 32 6f 3a 70 75 6e 63 68 20 32 72 3e 20 62 et2o:punch 2r> b
0d60: 75 66 2d 73 74 61 74 65 20 32 21 20 3b 0a 2b 6e uf-state 2! ;.+n
0d70: 65 74 32 6f 3a 20 70 75 6e 63 68 2d 6c 6f 61 64 et2o: punch-load
0d80: 2c 20 28 20 24 3a 73 74 72 69 6e 67 20 2d 2d 20 , ( $:string --
0d90: 29 20 5c 67 20 75 73 65 20 66 6f 72 20 70 75 6e ) \g use for pun
0da0: 63 68 20 70 61 79 6c 6f 61 64 3a 20 6e 65 73 74 ch payload: nest
0db0: 20 69 74 0a 20 20 20 20 24 3e 20 70 75 6e 63 68 it. $> punch
0dc0: 2d 6c 6f 61 64 20 24 21 20 3b 0a 2b 6e 65 74 32 -load $! ;.+net2
0dd0: 6f 3a 20 70 75 6e 63 68 2d 64 6f 6e 65 20 28 20 o: punch-done (
0de0: 2d 2d 20 29 20 5c 67 20 70 75 6e 63 68 20 72 65 -- ) \g punch re
0df0: 63 65 69 76 65 64 0a 20 20 20 20 6f 20 30 3c 3e ceived. o 0<>
0e00: 20 6f 77 6e 2d 63 72 79 70 74 3f 20 61 6e 64 20 own-crypt? and
0e10: 49 46 0a 09 72 65 74 75 72 6e 2d 61 64 64 72 20 IF..return-addr
0e20: 72 65 74 75 72 6e 2d 61 64 64 72 65 73 73 20 24 return-address $
0e30: 31 30 20 6d 6f 76 65 20 20 72 65 73 65 6e 64 30 10 move resend0
0e40: 20 24 6f 66 66 0a 09 6e 61 74 28 20 74 69 63 6b $off..nat( tick
0e50: 73 20 2e 74 69 63 6b 73 20 2e 22 20 20 70 75 6e s .ticks ." pun
0e60: 63 68 20 64 6f 6e 65 3a 20 22 20 72 65 74 75 72 ch done: " retur
0e70: 6e 2d 61 64 64 72 65 73 73 20 2e 61 64 64 72 2d n-address .addr-
0e80: 70 61 74 68 20 66 6f 72 74 68 3a 63 72 20 29 0a path forth:cr ).
0e90: 20 20 20 20 45 4c 53 45 0a 09 6e 61 74 28 20 74 ELSE..nat( t
0ea0: 69 63 6b 73 20 2e 74 69 63 6b 73 20 2e 22 20 20 icks .ticks ."
0eb0: 70 75 6e 63 68 20 6e 6f 74 20 64 6f 6e 65 3a 20 punch not done:
0ec0: 22 20 72 65 74 75 72 6e 2d 61 64 64 72 20 2e 61 " return-addr .a
0ed0: 64 64 72 2d 70 61 74 68 20 66 6f 72 74 68 3a 63 ddr-path forth:c
0ee0: 72 20 29 0a 20 20 20 20 54 48 45 4e 20 3b 0a 0a r ). THEN ;..
0ef0: 3a 20 63 6f 6f 6b 69 65 2c 20 28 20 78 74 64 20 : cookie, ( xtd
0f00: 78 74 74 6f 20 2d 2d 20 29 20 20 61 64 64 2d 63 xtto -- ) add-c
0f10: 6f 6f 6b 69 65 20 6c 69 74 2c 20 73 65 74 2d 63 ookie lit, set-c
0f20: 6f 6f 6b 69 65 20 3b 0a 3a 20 23 72 65 71 75 65 ookie ;.: #reque
0f30: 73 74 2c 20 28 20 2d 2d 20 29 20 20 75 6c 69 74 st, ( -- ) ulit
0f40: 2c 20 72 65 71 75 65 73 74 2d 64 6f 6e 65 20 3b , request-done ;
0f50: 0a 3a 20 72 65 71 75 65 73 74 2c 20 28 20 2d 2d .: request, ( --
0f60: 20 29 20 20 6e 65 78 74 2d 72 65 71 75 65 73 74 ) next-request
0f70: 20 23 72 65 71 75 65 73 74 2c 20 3b 0a 0a 3a 20 #request, ;..:
0f80: 67 65 6e 2d 70 75 6e 63 68 20 28 20 2d 2d 20 29 gen-punch ( -- )
0f90: 20 6e 61 74 28 20 2e 22 20 67 65 6e 20 70 75 6e nat( ." gen pun
0fa0: 63 68 65 73 22 20 66 6f 72 74 68 3a 63 72 20 29 ches" forth:cr )
0fb0: 0a 20 20 20 20 6d 79 2d 61 64 64 72 24 20 5b 3a . my-addr$ [:
0fc0: 20 2d 73 69 67 20 6e 61 74 28 20 74 69 63 6b 73 -sig nat( ticks
0fd0: 20 2e 74 69 63 6b 73 20 2e 22 20 20 67 65 6e 20 .ticks ." gen
0fe0: 70 75 6e 63 68 3a 20 22 20 32 64 75 70 20 2e 61 punch: " 2dup .a
0ff0: 64 64 72 24 20 66 6f 72 74 68 3a 63 72 20 29 20 ddr$ forth:cr )
1000: 24 2c 20 70 75 6e 63 68 20 3b 5d 20 24 5b 5d 6d $, punch ;] $[]m
1010: 61 70 20 3b 0a 0a 3a 20 63 6f 6f 6b 69 65 2b 72 ap ;..: cookie+r
1020: 65 71 75 65 73 74 20 28 20 2d 2d 20 29 20 72 65 equest ( -- ) re
1030: 71 75 65 73 74 28 20 2e 22 20 67 65 6e 20 63 6f quest( ." gen co
1040: 6f 6b 69 65 22 20 66 6f 72 74 68 3a 63 72 20 29 okie" forth:cr )
1050: 0a 20 20 20 20 6e 65 73 74 5b 20 6e 6f 2d 63 6f . nest[ no-co
1060: 6f 6b 69 65 2d 78 74 20 63 6f 6f 6b 69 65 2c 20 okie-xt cookie,
1070: 72 65 71 75 65 73 74 2c 20 5d 6e 65 73 74 20 3b request, ]nest ;
1080: 0a 0a 3a 20 6e 65 77 2d 70 75 6e 63 68 6c 6f 61 ..: new-punchloa
1090: 64 20 28 20 2d 2d 20 29 0a 20 20 20 20 6e 65 78 d ( -- ). nex
10a0: 74 2d 72 65 71 75 65 73 74 20 70 75 6e 63 68 2d t-request punch-
10b0: 67 65 6e 20 21 20 3b 0a 0a 3a 20 67 65 6e 2d 70 gen ! ;..: gen-p
10c0: 75 6e 63 68 6c 6f 61 64 20 28 20 2d 2d 20 29 20 unchload ( -- )
10d0: 72 65 71 75 65 73 74 28 20 2e 22 20 67 65 6e 20 request( ." gen
10e0: 70 75 6e 63 68 6c 6f 61 64 22 20 66 6f 72 74 68 punchload" forth
10f0: 3a 63 72 20 29 0a 20 20 20 20 6e 65 73 74 5b 20 :cr ). nest[
1100: 6e 6f 2d 63 6f 6f 6b 69 65 2d 78 74 20 63 6f 6f no-cookie-xt coo
1110: 6b 69 65 2c 20 70 75 6e 63 68 2d 64 6f 6e 65 20 kie, punch-done
1120: 70 75 6e 63 68 2d 67 65 6e 20 40 20 23 72 65 71 punch-gen @ #req
1130: 75 65 73 74 2c 20 5d 6e 65 73 74 24 20 70 75 6e uest, ]nest$ pun
1140: 63 68 2d 6c 6f 61 64 2c 20 3b 0a 0a 2b 6e 65 74 ch-load, ;..+net
1150: 32 6f 3a 20 70 75 6e 63 68 3f 20 28 20 2d 2d 20 2o: punch? ( --
1160: 29 20 5c 67 20 52 65 71 75 65 73 74 20 70 75 6e ) \g Request pun
1170: 63 68 20 61 64 64 72 65 73 73 65 73 0a 20 20 20 ch addresses.
1180: 20 67 65 6e 2d 70 75 6e 63 68 20 3b 0a 0a 5c 20 gen-punch ;..\
1190: 63 72 65 61 74 65 20 63 6f 6d 6d 61 6e 64 73 20 create commands
11a0: 74 6f 20 73 65 6e 64 20 62 61 63 6b 0a 0a 3a 20 to send back..:
11b0: 61 6c 6c 2d 69 76 73 20 28 20 2d 2d 20 29 20 5c all-ivs ( -- ) \
11c0: 67 20 53 65 65 64 20 61 6e 64 20 67 65 6e 20 61 g Seed and gen a
11d0: 6c 6c 20 49 56 53 0a 20 20 20 20 73 74 61 74 65 ll IVS. state
11e0: 23 20 72 6e 67 24 20 32 64 75 70 20 73 65 63 24 # rng$ 2dup sec$
11f0: 2c 20 67 65 6e 2d 69 76 73 20 69 76 73 2d 73 74 , gen-ivs ivs-st
1200: 72 69 6e 67 73 20 73 65 6e 64 2d 69 76 73 20 3b rings send-ivs ;
1210: 0a 0a 2b 6e 65 74 32 6f 3a 20 3e 74 69 6d 65 2d ..+net2o: >time-
1220: 6f 66 66 73 65 74 20 28 20 6e 20 2d 2d 20 29 20 offset ( n -- )
1230: 5c 67 20 73 65 74 20 74 69 6d 65 20 6f 66 66 73 \g set time offs
1240: 65 74 0a 20 20 20 20 6f 20 49 46 20 20 61 63 6b et. o IF ack
1250: 40 20 2e 74 69 6d 65 2d 6f 66 66 73 65 74 20 36 @ .time-offset 6
1260: 34 21 20 20 45 4c 53 45 20 20 36 34 64 72 6f 70 4! ELSE 64drop
1270: 20 20 54 48 45 4e 20 3b 0a 2b 6e 65 74 32 6f 3a THEN ;.+net2o:
1280: 20 63 6f 6e 74 65 78 74 20 28 20 2d 2d 20 29 20 context ( -- )
1290: 5c 67 20 6d 61 6b 65 20 63 6f 6e 74 65 78 74 20 \g make context
12a0: 61 63 74 69 76 65 0a 20 20 20 20 6f 20 49 46 20 active. o IF
12b0: 20 63 6f 6e 74 65 78 74 21 20 20 45 4c 53 45 20 context! ELSE
12c0: 20 63 6f 6e 6e 65 63 74 28 20 2e 22 20 43 61 6e connect( ." Can
12d0: 27 74 20 22 20 29 20 20 54 48 45 4e 0a 20 20 20 't " ) THEN.
12e0: 20 63 6f 6e 6e 65 63 74 28 20 2e 22 20 65 73 74 connect( ." est
12f0: 61 62 6c 69 73 68 20 61 20 63 6f 6e 74 65 78 74 ablish a context
1300: 21 22 20 66 6f 72 74 68 3a 63 72 20 29 20 3b 0a !" forth:cr ) ;.
1310: 0a 3a 20 74 69 6d 65 2d 6f 66 66 73 65 74 21 20 .: time-offset!
1320: 28 20 2d 2d 20 29 20 20 74 69 63 6b 73 20 36 34 ( -- ) ticks 64
1330: 64 75 70 20 6c 69 74 2c 20 3e 74 69 6d 65 2d 6f dup lit, >time-o
1340: 66 66 73 65 74 20 61 63 6b 40 20 2e 74 69 6d 65 ffset ack@ .time
1350: 2d 6f 66 66 73 65 74 20 36 34 21 20 3b 0a 3a 20 -offset 64! ;.:
1360: 72 65 70 6c 79 2d 6b 65 79 2c 20 28 20 2d 2d 20 reply-key, ( --
1370: 29 0a 20 20 20 20 6e 65 73 74 5b 20 70 6b 63 20 ). nest[ pkc
1380: 6b 65 79 73 69 7a 65 20 24 2c 20 70 75 62 6b 65 keysize $, pubke
1390: 79 20 24 40 6c 65 6e 20 30 3e 20 6b 65 79 70 61 y $@len 0> keypa
13a0: 64 24 20 6e 69 70 20 6b 65 79 73 69 7a 65 20 75 d$ nip keysize u
13b0: 3c 3d 20 61 6e 64 20 49 46 0a 09 70 75 62 6b 65 <= and IF..pubke
13c0: 79 20 24 40 20 6b 65 79 7c 20 24 2c 20 6b 65 79 y $@ key| $, key
13d0: 70 61 69 72 0a 09 70 75 62 6b 65 79 20 24 40 20 pair..pubkey $@
13e0: 64 72 6f 70 20 73 6b 63 20 6b 65 79 2d 73 74 61 drop skc key-sta
13f0: 67 65 32 0a 20 20 20 20 45 4c 53 45 20 20 72 65 ge2. ELSE re
1400: 63 65 69 76 65 2d 6b 65 79 20 20 54 48 45 4e 0a ceive-key THEN.
1410: 20 20 20 20 75 70 64 61 74 65 2d 6b 65 79 20 61 update-key a
1420: 6c 6c 2d 69 76 73 20 3b 0a 0a 2b 6e 65 74 32 6f ll-ivs ;..+net2o
1430: 3a 20 67 65 6e 2d 72 65 70 6c 79 20 28 20 2d 2d : gen-reply ( --
1440: 20 29 20 5c 67 20 67 65 6e 65 72 61 74 65 20 61 ) \g generate a
1450: 20 6b 65 79 20 72 65 71 75 65 73 74 20 72 65 70 key request rep
1460: 6c 79 0a 20 20 20 20 6f 77 6e 2d 63 72 79 70 74 ly. own-crypt
1470: 3f 20 30 3d 20 3f 45 58 49 54 0a 20 20 20 20 5b ? 0= ?EXIT. [
1480: 3a 20 63 72 79 70 74 28 20 2e 22 20 52 65 70 6c : crypt( ." Repl
1490: 79 20 6b 65 79 3a 20 22 20 74 6d 70 6b 65 79 40 y key: " tmpkey@
14a0: 20 2e 6e 6e 62 20 66 6f 72 74 68 3a 63 72 20 29 .nnb forth:cr )
14b0: 0a 20 20 20 20 20 20 72 65 70 6c 79 2d 6b 65 79 . reply-key
14c0: 2c 20 28 20 63 6f 6f 6b 69 65 2b 72 65 71 75 65 , ( cookie+reque
14d0: 73 74 20 29 20 74 69 6d 65 2d 6f 66 66 73 65 74 st ) time-offset
14e0: 21 20 63 6f 6e 74 65 78 74 20 5d 74 6d 70 6e 65 ! context ]tmpne
14f0: 73 74 0a 20 20 20 20 20 20 70 75 73 68 2d 63 6d st. push-cm
1500: 64 20 3b 5d 20 20 49 53 20 65 78 70 65 63 74 2d d ;] IS expect-
1510: 72 65 70 6c 79 3f 20 3b 0a 2b 6e 65 74 32 6f 3a reply? ;.+net2o:
1520: 20 67 65 6e 2d 70 75 6e 63 68 2d 72 65 70 6c 79 gen-punch-reply
1530: 20 28 20 2d 2d 20 29 20 20 6f 3f 20 5c 67 20 67 ( -- ) o? \g g
1540: 65 6e 65 72 61 74 65 20 61 20 70 75 6e 63 68 20 enerate a punch
1550: 72 65 71 75 65 73 74 20 72 65 70 6c 79 0a 20 20 request reply.
1560: 20 20 5b 3a 20 63 72 79 70 74 28 20 2e 22 20 52 [: crypt( ." R
1570: 65 70 6c 79 20 6b 65 79 3a 20 22 20 74 6d 70 6b eply key: " tmpk
1580: 65 79 40 20 2e 6e 6e 62 20 66 6f 72 74 68 3a 63 ey@ .nnb forth:c
1590: 72 20 29 0a 20 20 20 20 20 20 72 65 70 6c 79 2d r ). reply-
15a0: 6b 65 79 2c 20 74 69 6d 65 2d 6f 66 66 73 65 74 key, time-offset
15b0: 21 20 67 65 6e 2d 70 75 6e 63 68 6c 6f 61 64 20 ! gen-punchload
15c0: 67 65 6e 2d 70 75 6e 63 68 20 63 6f 6e 74 65 78 gen-punch contex
15d0: 74 20 5d 74 6d 70 6e 65 73 74 0a 20 20 20 20 20 t ]tmpnest.
15e0: 20 70 75 73 68 2d 63 6d 64 20 3b 5d 20 20 49 53 push-cmd ;] IS
15f0: 20 65 78 70 65 63 74 2d 72 65 70 6c 79 3f 20 3b expect-reply? ;
1600: 0a 0a 5c 20 6f 6e 65 2d 73 68 6f 74 20 70 61 63 ..\ one-shot pac
1610: 6b 65 74 73 0a 0a 2b 6e 65 74 32 6f 3a 20 6f 6e kets..+net2o: on
1620: 65 73 68 6f 74 2d 74 6d 70 6b 65 79 20 28 20 24 eshot-tmpkey ( $
1630: 3a 74 6d 70 6b 65 79 20 2d 2d 20 29 20 5c 67 20 :tmpkey -- ) \g
1640: 6f 6e 65 73 68 6f 74 20 74 6d 70 6b 65 79 0a 20 oneshot tmpkey.
1650: 20 20 20 24 3e 20 6b 65 79 73 69 7a 65 20 3c 3e $> keysize <>
1660: 20 21 21 6b 65 79 73 69 7a 65 21 21 20 73 6b 63 !!keysize!! skc
1670: 20 73 77 61 70 20 6b 65 79 70 61 64 20 65 64 2d swap keypad ed-
1680: 64 68 20 64 6f 2d 6b 65 79 70 61 64 20 73 65 63 dh do-keypad sec
1690: 21 20 3b 0a 2b 6e 65 74 32 6f 3a 20 69 6e 76 69 ! ;.+net2o: invi
16a0: 74 65 20 28 20 24 3a 6e 69 63 6b 2b 73 69 67 20 te ( $:nick+sig
16b0: 2d 2d 20 29 20 5c 67 20 69 6e 76 69 74 65 20 73 -- ) \g invite s
16c0: 6f 6d 65 6f 6e 65 0a 20 20 20 20 24 3e 20 74 6d omeone. $> tm
16d0: 70 2d 63 72 79 70 74 3f 20 49 46 0a 09 70 6b 32 p-crypt? IF..pk2
16e0: 2d 73 69 67 3f 20 21 21 73 69 67 21 21 20 3e 69 -sig? !!sig!! >i
16f0: 6e 76 69 74 61 74 69 6f 6e 73 20 64 6f 2d 6b 65 nvitations do-ke
1700: 79 70 61 64 20 73 65 63 2d 6f 66 66 0a 20 20 20 ypad sec-off.
1710: 20 45 4c 53 45 20 20 32 64 72 6f 70 20 20 54 48 ELSE 2drop TH
1720: 45 4e 20 3b 0a 0a 67 65 6e 2d 74 61 62 6c 65 20 EN ;..gen-table
1730: 24 66 72 65 65 7a 65 0a 0a 7d 73 63 6f 70 65 0a $freeze..}scope.
1740: 0a 30 20 5b 49 46 5d 0a 4c 6f 63 61 6c 20 56 61 .0 [IF].Local Va
1750: 72 69 61 62 6c 65 73 3a 0a 66 6f 72 74 68 2d 6c riables:.forth-l
1760: 6f 63 61 6c 2d 77 6f 72 64 73 3a 0a 20 20 20 20 ocal-words:.
1770: 28 0a 20 20 20 20 20 28 28 22 6e 65 74 32 6f 3a (. (("net2o:
1780: 22 20 22 2b 6e 65 74 32 6f 3a 22 29 20 64 65 66 " "+net2o:") def
1790: 69 6e 69 74 69 6f 6e 2d 73 74 61 72 74 65 72 20 inition-starter
17a0: 28 66 6f 6e 74 2d 6c 6f 63 6b 2d 6b 65 79 77 6f (font-lock-keywo
17b0: 72 64 2d 66 61 63 65 20 2e 20 31 29 0a 20 20 20 rd-face . 1).
17c0: 20 20 20 22 5b 20 5c 74 5c 6e 5d 22 20 74 20 6e "[ \t\n]" t n
17d0: 61 6d 65 20 28 66 6f 6e 74 2d 6c 6f 63 6b 2d 66 ame (font-lock-f
17e0: 75 6e 63 74 69 6f 6e 2d 6e 61 6d 65 2d 66 61 63 unction-name-fac
17f0: 65 20 2e 20 33 29 29 0a 20 20 20 20 20 28 22 5b e . 3)). ("[
1800: 61 2d 7a 5c 2d 30 2d 39 5d 2b 28 22 20 69 6d 6d a-z\-0-9]+(" imm
1810: 65 64 69 61 74 65 20 28 66 6f 6e 74 2d 6c 6f 63 ediate (font-loc
1820: 6b 2d 63 6f 6d 6d 65 6e 74 2d 66 61 63 65 20 2e k-comment-face .
1830: 20 31 29 0a 20 20 20 20 20 20 22 29 22 20 6e 69 1). ")" ni
1840: 6c 20 63 6f 6d 6d 65 6e 74 20 28 66 6f 6e 74 2d l comment (font-
1850: 6c 6f 63 6b 2d 63 6f 6d 6d 65 6e 74 2d 66 61 63 lock-comment-fac
1860: 65 20 2e 20 31 29 29 0a 20 20 20 20 29 0a 66 6f e . 1)). ).fo
1870: 72 74 68 2d 6c 6f 63 61 6c 2d 69 6e 64 65 6e 74 rth-local-indent
1880: 2d 77 6f 72 64 73 3a 0a 20 20 20 20 28 0a 20 20 -words:. (.
1890: 20 20 20 28 28 22 6e 65 74 32 6f 3a 22 20 22 2b (("net2o:" "+
18a0: 6e 65 74 32 6f 3a 22 29 20 28 30 20 2e 20 32 29 net2o:") (0 . 2)
18b0: 20 28 30 20 2e 20 32 29 20 6e 6f 6e 2d 69 6d 6d (0 . 2) non-imm
18c0: 65 64 69 61 74 65 29 0a 20 20 20 20 20 28 28 22 ediate). (("
18d0: 5b 3a 22 29 20 28 30 20 2e 20 31 29 20 28 30 20 [:") (0 . 1) (0
18e0: 2e 20 31 29 20 69 6d 6d 65 64 69 61 74 65 29 0a . 1) immediate).
18f0: 20 20 20 20 20 28 28 22 3b 5d 22 29 20 28 2d 31 ((";]") (-1
1900: 20 2e 20 30 29 20 28 30 20 2e 20 2d 31 29 20 69 . 0) (0 . -1) i
1910: 6d 6d 65 64 69 61 74 65 29 0a 20 20 20 20 29 0a mmediate). ).
1920: 45 6e 64 3a 0a 5b 54 48 45 4e 5d End:.[THEN]