Artifact
9c42b56aef4959bf79e2ada3a0a5fd944534eab7:
- File
helper.fs
— part of check-in
[ff117dd91d]
at
2019-07-14 21:15:24
on branch trunk
— Lock/unlock of chat looks good now
(user:
bernd
size: 12145)
0000: 5c 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 73 65 74 \ connection set
0010: 75 70 20 68 65 6c 70 65 72 0a 0a 5c 20 43 6f 70 up helper..\ Cop
0020: 79 72 69 67 68 74 20 28 43 29 20 32 30 31 35 20 yright (C) 2015
0030: 20 20 42 65 72 6e 64 20 50 61 79 73 61 6e 0a 0a Bernd Paysan..
0040: 5c 20 54 68 69 73 20 70 72 6f 67 72 61 6d 20 69 \ This program i
0050: 73 20 66 72 65 65 20 73 6f 66 74 77 61 72 65 3a s free software:
0060: 20 79 6f 75 20 63 61 6e 20 72 65 64 69 73 74 72 you can redistr
0070: 69 62 75 74 65 20 69 74 20 61 6e 64 2f 6f 72 20 ibute it and/or
0080: 6d 6f 64 69 66 79 0a 5c 20 69 74 20 75 6e 64 65 modify.\ it unde
0090: 72 20 74 68 65 20 74 65 72 6d 73 20 6f 66 20 74 r the terms of t
00a0: 68 65 20 47 4e 55 20 41 66 66 65 72 6f 20 47 65 he GNU Affero Ge
00b0: 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 4c 69 63 neral Public Lic
00c0: 65 6e 73 65 20 61 73 20 70 75 62 6c 69 73 68 65 ense as publishe
00d0: 64 20 62 79 0a 5c 20 74 68 65 20 46 72 65 65 20 d by.\ the Free
00e0: 53 6f 66 74 77 61 72 65 20 46 6f 75 6e 64 61 74 Software Foundat
00f0: 69 6f 6e 2c 20 65 69 74 68 65 72 20 76 65 72 73 ion, either vers
0100: 69 6f 6e 20 33 20 6f 66 20 74 68 65 20 4c 69 63 ion 3 of the Lic
0110: 65 6e 73 65 2c 20 6f 72 0a 5c 20 28 61 74 20 79 ense, or.\ (at y
0120: 6f 75 72 20 6f 70 74 69 6f 6e 29 20 61 6e 79 20 our option) any
0130: 6c 61 74 65 72 20 76 65 72 73 69 6f 6e 2e 0a 0a later version...
0140: 5c 20 54 68 69 73 20 70 72 6f 67 72 61 6d 20 69 \ This program i
0150: 73 20 64 69 73 74 72 69 62 75 74 65 64 20 69 6e s distributed in
0160: 20 74 68 65 20 68 6f 70 65 20 74 68 61 74 20 69 the hope that i
0170: 74 20 77 69 6c 6c 20 62 65 20 75 73 65 66 75 6c t will be useful
0180: 2c 0a 5c 20 62 75 74 20 57 49 54 48 4f 55 54 20 ,.\ but WITHOUT
0190: 41 4e 59 20 57 41 52 52 41 4e 54 59 3b 20 77 69 ANY WARRANTY; wi
01a0: 74 68 6f 75 74 20 65 76 65 6e 20 74 68 65 20 69 thout even the i
01b0: 6d 70 6c 69 65 64 20 77 61 72 72 61 6e 74 79 20 mplied warranty
01c0: 6f 66 0a 5c 20 4d 45 52 43 48 41 4e 54 41 42 49 of.\ MERCHANTABI
01d0: 4c 49 54 59 20 6f 72 20 46 49 54 4e 45 53 53 20 LITY or FITNESS
01e0: 46 4f 52 20 41 20 50 41 52 54 49 43 55 4c 41 52 FOR A PARTICULAR
01f0: 20 50 55 52 50 4f 53 45 2e 20 20 53 65 65 20 74 PURPOSE. See t
0200: 68 65 0a 5c 20 47 4e 55 20 41 66 66 65 72 6f 20 he.\ GNU Affero
0210: 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 4c General Public L
0220: 69 63 65 6e 73 65 20 66 6f 72 20 6d 6f 72 65 20 icense for more
0230: 64 65 74 61 69 6c 73 2e 0a 0a 5c 20 59 6f 75 20 details...\ You
0240: 73 68 6f 75 6c 64 20 68 61 76 65 20 72 65 63 65 should have rece
0250: 69 76 65 64 20 61 20 63 6f 70 79 20 6f 66 20 74 ived a copy of t
0260: 68 65 20 47 4e 55 20 41 66 66 65 72 6f 20 47 65 he GNU Affero Ge
0270: 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 4c 69 63 neral Public Lic
0280: 65 6e 73 65 0a 5c 20 61 6c 6f 6e 67 20 77 69 74 ense.\ along wit
0290: 68 20 74 68 69 73 20 70 72 6f 67 72 61 6d 2e 20 h this program.
02a0: 20 49 66 20 6e 6f 74 2c 20 73 65 65 20 3c 68 74 If not, see <ht
02b0: 74 70 3a 2f 2f 77 77 77 2e 67 6e 75 2e 6f 72 67 tp://www.gnu.org
02c0: 2f 6c 69 63 65 6e 73 65 73 2f 3e 2e 0a 0a 24 56 /licenses/>...$V
02d0: 61 72 69 61 62 6c 65 20 64 68 74 6e 69 63 6b 20 ariable dhtnick
02e0: 22 6e 65 74 32 6f 2d 64 68 74 72 6f 6f 74 22 20 "net2o-dhtroot"
02f0: 64 68 74 6e 69 63 6b 20 24 21 0a 24 56 61 72 69 dhtnick $!.$Vari
0300: 61 62 6c 65 20 64 68 74 72 6f 6f 74 2d 61 64 64 able dhtroot-add
0310: 72 24 0a 56 61 72 69 61 62 6c 65 20 64 68 74 72 r$.Variable dhtr
0320: 6f 6f 74 2d 61 64 64 72 0a 0a 3a 6e 6f 6e 61 6d oot-addr..:nonam
0330: 65 20 64 65 66 65 72 73 20 27 63 6f 6c 64 20 64 e defers 'cold d
0340: 68 74 72 6f 6f 74 2d 61 64 64 72 20 6f 66 66 20 htroot-addr off
0350: 3b 20 69 73 20 27 63 6f 6c 64 0a 0a 72 65 71 75 ; is 'cold..requ
0360: 69 72 65 20 64 68 74 72 6f 6f 74 2e 66 73 0a 0a ire dhtroot.fs..
0370: 3a 20 64 68 74 72 6f 6f 74 2d 61 64 64 72 40 20 : dhtroot-addr@
0380: 28 20 2d 2d 20 61 64 64 72 20 29 0a 20 20 20 20 ( -- addr ).
0390: 64 68 74 72 6f 6f 74 2d 61 64 64 72 20 40 20 3f dhtroot-addr @ ?
03a0: 64 75 70 2d 49 46 20 20 45 58 49 54 20 20 54 48 dup-IF EXIT TH
03b0: 45 4e 0a 20 20 20 20 64 68 74 72 6f 6f 74 2d 61 EN. dhtroot-a
03c0: 64 64 72 24 20 24 40 20 64 75 70 20 49 46 0a 09 ddr$ $@ dup IF..
03d0: 3e 68 6f 73 74 20 64 68 74 6e 69 63 6b 20 24 40 >host dhtnick $@
03e0: 20 6e 69 63 6b 3e 70 6b 20 64 72 6f 70 20 64 61 nick>pk drop da
03f0: 74 65 2d 73 69 67 3f 20 30 3d 20 49 46 0a 09 20 te-sig? 0= IF..
0400: 20 20 20 73 69 67 73 69 7a 65 23 20 2d 20 20 6e sigsize# - n
0410: 65 77 2d 61 64 64 72 20 64 75 70 20 64 68 74 72 ew-addr dup dhtr
0420: 6f 6f 74 2d 61 64 64 72 20 21 0a 09 20 20 20 20 oot-addr !..
0430: 45 58 49 54 20 20 54 48 45 4e 20 20 54 48 45 4e EXIT THEN THEN
0440: 0a 20 20 20 20 32 64 72 6f 70 20 30 20 3b 0a 0a . 2drop 0 ;..
0450: 3a 20 21 30 6b 65 79 20 28 20 2d 2d 20 29 0a 20 : !0key ( -- ).
0460: 20 20 20 64 65 73 74 2d 30 6b 65 79 3c 20 40 20 dest-0key< @
0470: 49 46 0a 09 5c 20 63 68 65 63 6b 20 66 6f 72 20 IF..\ check for
0480: 64 69 73 63 6f 6e 6e 65 63 74 65 64 20 73 74 61 disconnected sta
0490: 74 65 0a 09 69 6e 64 2d 61 64 64 72 20 40 20 30 te..ind-addr @ 0
04a0: 3d 20 6c 61 73 74 61 64 64 72 23 20 61 6e 64 20 = lastaddr# and
04b0: 49 46 0a 09 20 20 20 20 64 65 73 74 2d 30 6b 65 IF.. dest-0ke
04c0: 79 3c 20 73 65 63 40 20 6c 61 73 74 61 64 64 72 y< sec@ lastaddr
04d0: 23 20 63 65 6c 6c 2b 20 24 21 20 20 54 48 45 4e # cell+ $! THEN
04e0: 0a 09 64 65 73 74 2d 30 6b 65 79 3e 20 40 20 49 ..dest-0key> @ I
04f0: 46 20 20 64 65 73 74 2d 30 6b 65 79 3c 20 73 65 F dest-0key< se
0500: 63 40 20 64 65 73 74 2d 30 6b 65 79 3e 20 40 20 c@ dest-0key> @
0510: 73 65 63 21 20 20 54 48 45 4e 0a 20 20 20 20 54 sec! THEN. T
0520: 48 45 4e 20 3b 0a 0a 30 20 76 61 6c 75 65 20 6f HEN ;..0 value o
0530: 6e 6c 69 6e 65 3f 0a 0a 3a 20 64 68 74 72 6f 6f nline?..: dhtroo
0540: 74 20 28 20 2d 2d 20 29 0a 20 20 20 20 30 20 74 t ( -- ). 0 t
0550: 6f 20 6c 61 73 74 61 64 64 72 23 0a 20 20 20 20 o lastaddr#.
0560: 64 68 74 72 6f 6f 74 2d 61 64 64 72 40 20 3f 64 dhtroot-addr@ ?d
0570: 75 70 2d 49 46 0a 09 30 20 73 77 61 70 0a 09 5b up-IF..0 swap..[
0580: 3a 20 64 75 70 20 3f 45 58 49 54 0a 09 20 20 20 : dup ?EXIT..
0590: 20 63 68 65 63 6b 2d 61 64 64 72 31 20 49 46 20 check-addr1 IF
05a0: 20 69 6e 73 65 72 74 2d 61 64 64 72 65 73 73 20 insert-address
05b0: 6e 69 70 0a 09 20 20 20 20 45 4c 53 45 20 20 32 nip.. ELSE 2
05c0: 64 72 6f 70 20 20 54 48 45 4e 20 3b 5d 20 61 64 drop THEN ;] ad
05d0: 64 72 3e 73 6f 63 6b 0a 20 20 20 20 45 4c 53 45 dr>sock. ELSE
05e0: 20 20 6e 65 74 32 6f 2d 68 6f 73 74 20 24 40 20 net2o-host $@
05f0: 6e 65 74 32 6f 2d 70 6f 72 74 20 69 6e 73 65 72 net2o-port inser
0600: 74 2d 69 70 0a 20 20 20 20 54 48 45 4e 20 20 72 t-ip. THEN r
0610: 65 74 75 72 6e 2d 61 64 64 72 20 64 75 70 20 24 eturn-addr dup $
0620: 31 30 20 65 72 61 73 65 20 62 65 21 0a 20 20 20 10 erase be!.
0630: 20 6c 61 73 74 61 64 64 72 23 20 30 3c 3e 20 74 lastaddr# 0<> t
0640: 6f 20 6f 6e 6c 69 6e 65 3f 0a 20 20 20 20 69 6e o online?. in
0650: 64 2d 61 64 64 72 20 6f 66 66 20 20 21 30 6b 65 d-addr off !0ke
0660: 79 20 3b 0a 0a 3a 20 64 68 74 72 6f 6f 74 2d 6f y ;..: dhtroot-o
0670: 66 66 20 28 20 2d 2d 2d 20 29 0a 20 20 20 20 64 ff ( --- ). d
0680: 68 74 72 6f 6f 74 2d 61 64 64 72 24 20 24 6f 66 htroot-addr$ $of
0690: 66 0a 20 20 20 20 64 68 74 72 6f 6f 74 2d 61 64 f. dhtroot-ad
06a0: 64 72 20 40 20 3f 64 75 70 2d 49 46 20 20 6e 65 dr @ ?dup-IF ne
06b0: 74 32 6f 3a 64 69 73 70 6f 73 65 2d 61 64 64 72 t2o:dispose-addr
06c0: 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 69 6e 73 2d THEN ;..: ins-
06d0: 69 70 20 28 20 2d 2d 20 6e 65 74 32 6f 61 64 64 ip ( -- net2oadd
06e0: 72 20 29 0a 20 20 20 20 6e 65 74 32 6f 2d 68 6f r ). net2o-ho
06f0: 73 74 20 24 40 20 6e 65 74 32 6f 2d 70 6f 72 74 st $@ net2o-port
0700: 20 69 6e 73 65 72 74 2d 69 70 20 20 69 6e 64 2d insert-ip ind-
0710: 61 64 64 72 20 6f 66 66 20 3b 0a 3a 20 69 6e 73 addr off ;.: ins
0720: 2d 69 70 34 20 28 20 2d 2d 20 6e 65 74 32 6f 61 -ip4 ( -- net2oa
0730: 64 64 72 20 29 0a 20 20 20 20 6e 65 74 32 6f 2d ddr ). net2o-
0740: 68 6f 73 74 20 24 40 20 6e 65 74 32 6f 2d 70 6f host $@ net2o-po
0750: 72 74 20 69 6e 73 65 72 74 2d 69 70 34 20 69 6e rt insert-ip4 in
0760: 64 2d 61 64 64 72 20 6f 66 66 20 3b 0a 3a 20 69 d-addr off ;.: i
0770: 6e 73 2d 69 70 36 20 28 20 2d 2d 20 6e 65 74 32 ns-ip6 ( -- net2
0780: 6f 61 64 64 72 20 29 0a 20 20 20 20 6e 65 74 32 oaddr ). net2
0790: 6f 2d 68 6f 73 74 20 24 40 20 6e 65 74 32 6f 2d o-host $@ net2o-
07a0: 70 6f 72 74 20 69 6e 73 65 72 74 2d 69 70 36 20 port insert-ip6
07b0: 69 6e 64 2d 61 64 64 72 20 6f 66 66 20 3b 0a 0a ind-addr off ;..
07c0: 3a 20 70 6b 3a 63 6f 6e 6e 65 63 74 20 28 20 63 : pk:connect ( c
07d0: 6f 64 65 20 64 61 74 61 20 6b 65 79 20 75 20 2d ode data key u -
07e0: 2d 20 29 0a 20 20 20 20 63 6f 6e 6e 65 63 74 28 - ). connect(
07f0: 20 5b 3a 20 2e 74 69 6d 65 20 2e 22 20 43 6f 6e [: .time ." Con
0800: 6e 65 63 74 20 74 6f 3a 20 22 20 64 75 70 20 68 nect to: " dup h
0810: 65 78 2e 20 63 72 20 3b 5d 20 24 65 72 72 20 29 ex. cr ;] $err )
0820: 0a 20 20 20 20 6e 65 74 32 6f 3a 6e 65 77 2d 63 . net2o:new-c
0830: 6f 6e 74 65 78 74 20 3e 6f 20 72 64 72 6f 70 20 ontext >o rdrop
0840: 6f 20 74 6f 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 o to connection
0850: 20 73 65 74 75 70 21 0a 20 20 20 20 64 65 73 74 setup!. dest
0860: 2d 70 6b 20 5c 20 73 65 74 20 6f 75 72 20 64 65 -pk \ set our de
0870: 73 74 69 6e 61 74 69 6f 6e 20 6b 65 79 0a 20 20 stination key.
0880: 20 20 2b 72 65 73 65 6e 64 2d 63 6d 64 20 6e 65 +resend-cmd ne
0890: 74 32 6f 3a 63 6f 6e 6e 65 63 74 0a 20 20 20 20 t2o:connect.
08a0: 2b 66 6c 6f 77 2d 63 6f 6e 74 72 6f 6c 20 2b 72 +flow-control +r
08b0: 65 73 65 6e 64 0a 20 20 20 20 63 6f 6e 6e 65 63 esend. connec
08c0: 74 28 20 5b 3a 20 2e 74 69 6d 65 20 2e 22 20 43 t( [: .time ." C
08d0: 6f 6e 6e 65 63 74 65 64 2c 20 6f 3d 22 20 6f 20 onnected, o=" o
08e0: 68 65 78 2e 20 63 72 20 3b 5d 20 24 65 72 72 20 hex. cr ;] $err
08f0: 29 20 3b 0a 0a 46 6f 72 77 61 72 64 20 72 65 6e ) ;..Forward ren
0900: 61 74 2d 61 6c 6c 0a 0a 65 76 65 6e 74 3a 20 3a at-all..event: :
0910: 3e 72 65 6e 61 74 20 28 20 2d 2d 20 29 20 20 72 >renat ( -- ) r
0920: 65 6e 61 74 2d 61 6c 6c 20 3b 0a 65 76 65 6e 74 enat-all ;.event
0930: 3a 20 3a 3e 64 69 73 63 6f 6e 6e 65 63 74 20 28 : :>disconnect (
0940: 20 61 64 64 72 20 2d 2d 20 29 20 20 2e 64 69 73 addr -- ) .dis
0950: 63 6f 6e 6e 65 63 74 2d 6d 65 20 3b 0a 3a 20 64 connect-me ;.: d
0960: 68 74 2d 62 65 61 63 6f 6e 20 28 20 61 64 64 72 ht-beacon ( addr
0970: 20 75 20 2d 2d 20 29 0a 20 20 20 20 3c 65 76 65 u -- ). <eve
0980: 6e 74 20 3a 3e 72 65 6e 61 74 20 6d 61 69 6e 2d nt :>renat main-
0990: 75 70 40 20 65 76 65 6e 74 3e 20 32 64 72 6f 70 up@ event> 2drop
09a0: 20 3b 0a 0a 3a 20 2b 64 68 74 2d 62 65 61 63 6f ;..: +dht-beaco
09b0: 6e 20 28 20 2d 2d 20 29 0a 20 20 20 20 62 65 61 n ( -- ). bea
09c0: 63 6f 6e 73 23 20 40 20 30 3d 20 49 46 20 20 72 cons# @ 0= IF r
09d0: 65 74 2d 61 64 64 72 20 62 65 40 20 5b 27 5d 20 et-addr be@ [']
09e0: 64 68 74 2d 62 65 61 63 6f 6e 20 30 20 2e 61 64 dht-beacon 0 .ad
09f0: 64 2d 62 65 61 63 6f 6e 20 20 54 48 45 4e 20 3b d-beacon THEN ;
0a00: 0a 0a 3a 20 64 68 74 2d 63 6f 6e 6e 65 63 74 20 ..: dht-connect
0a10: 28 20 2d 2d 20 29 0a 20 20 20 20 64 68 74 2d 63 ( -- ). dht-c
0a20: 6f 6e 6e 65 63 74 69 6f 6e 20 3f 64 75 70 2d 49 onnection ?dup-I
0a30: 46 20 20 3e 6f 20 6f 20 74 6f 20 63 6f 6e 6e 65 F >o o to conne
0a40: 63 74 69 6f 6e 20 72 64 72 6f 70 20 20 45 58 49 ction rdrop EXI
0a50: 54 20 20 54 48 45 4e 0a 20 20 20 20 74 69 63 6b T THEN. tick
0a60: 2d 61 64 6a 75 73 74 20 36 34 40 20 36 34 2d 30 -adjust 64@ 64-0
0a70: 3d 20 49 46 20 20 2b 67 65 74 2d 74 69 6d 65 20 = IF +get-time
0a80: 20 54 48 45 4e 0a 20 20 20 20 24 38 20 24 38 20 THEN. $8 $8
0a90: 64 68 74 6e 69 63 6b 20 24 40 20 6e 69 63 6b 3e dhtnick $@ nick>
0aa0: 70 6b 20 64 68 74 72 6f 6f 74 0a 20 20 20 20 6f pk dhtroot. o
0ab0: 6e 6c 69 6e 65 3f 20 49 46 20 20 2b 64 68 74 2d nline? IF +dht-
0ac0: 62 65 61 63 6f 6e 20 70 6b 3a 63 6f 6e 6e 65 63 beacon pk:connec
0ad0: 74 20 20 6f 20 74 6f 20 64 68 74 2d 63 6f 6e 6e t o to dht-conn
0ae0: 65 63 74 69 6f 6e 0a 20 20 20 20 45 4c 53 45 20 ection. ELSE
0af0: 20 32 64 72 6f 70 20 32 64 72 6f 70 20 20 54 48 2drop 2drop TH
0b00: 45 4e 20 3b 0a 3a 20 64 68 74 2d 64 69 73 63 6f EN ;.: dht-disco
0b10: 6e 6e 65 63 74 20 28 20 2d 2d 20 29 0a 20 20 20 nnect ( -- ).
0b20: 20 30 20 61 64 64 72 20 64 68 74 2d 63 6f 6e 6e 0 addr dht-conn
0b30: 65 63 74 69 6f 6e 20 21 40 20 3f 64 75 70 2d 49 ection !@ ?dup-I
0b40: 46 0a 09 3e 6f 20 6f 20 74 6f 20 63 6f 6e 6e 65 F..>o o to conne
0b50: 63 74 69 6f 6e 20 64 69 73 63 6f 6e 6e 65 63 74 ction disconnect
0b60: 2d 6d 65 20 30 20 74 6f 20 63 6f 6e 6e 65 63 74 -me 0 to connect
0b70: 69 6f 6e 20 6f 3e 20 20 54 48 45 4e 20 3b 0a 0a ion o> THEN ;..
0b80: 56 61 72 69 61 62 6c 65 20 61 6e 6e 6f 75 6e 63 Variable announc
0b90: 65 64 0a 3a 20 73 75 62 6d 65 20 28 20 2d 2d 20 ed.: subme ( --
0ba0: 29 20 20 61 6e 6e 6f 75 6e 63 65 64 20 40 20 49 ) announced @ I
0bb0: 46 0a 09 64 68 74 2d 63 6f 6e 6e 65 63 74 20 73 F..dht-connect s
0bc0: 75 62 2d 6d 65 20 54 48 45 4e 20 3b 0a 0a 3a 20 ub-me THEN ;..:
0bd0: 63 3a 64 69 73 63 6f 6e 6e 65 63 74 20 28 20 2d c:disconnect ( -
0be0: 2d 20 29 20 63 6f 6e 6e 65 63 74 28 20 5b 3a 20 - ) connect( [:
0bf0: 2e 22 20 44 69 73 63 6f 6e 6e 65 63 74 69 6e 67 ." Disconnecting
0c00: 2e 2e 2e 22 20 63 72 20 3b 5d 20 24 65 72 72 20 ..." cr ;] $err
0c10: 29 0a 20 20 20 20 64 69 73 63 6f 6e 6e 65 63 74 ). disconnect
0c20: 2d 6d 65 20 63 6f 6e 6e 65 63 74 28 20 5b 3a 20 -me connect( [:
0c30: 2e 70 61 63 6b 65 74 73 20 70 72 6f 66 69 6c 65 .packets profile
0c40: 28 20 2e 74 69 6d 65 73 20 29 20 3b 5d 20 24 65 ( .times ) ;] $e
0c50: 72 72 20 29 20 3b 0a 0a 3a 20 63 3a 66 65 74 63 rr ) ;..: c:fetc
0c60: 68 2d 69 64 20 28 20 70 75 62 6b 65 79 20 75 20 h-id ( pubkey u
0c70: 2d 2d 20 29 0a 20 20 20 20 6e 65 74 32 6f 2d 63 -- ). net2o-c
0c80: 6f 64 65 0a 20 20 20 20 20 20 65 78 70 65 63 74 ode. expect
0c90: 2d 72 65 70 6c 79 20 20 66 65 74 63 68 2d 69 64 -reply fetch-id
0ca0: 2c 0a 20 20 20 20 20 20 63 6f 6f 6b 69 65 2b 72 ,. cookie+r
0cb0: 65 71 75 65 73 74 0a 20 20 20 20 65 6e 64 2d 63 equest. end-c
0cc0: 6f 64 65 7c 20 3b 0a 0a 3a 20 70 6b 3a 66 65 74 ode| ;..: pk:fet
0cd0: 63 68 2d 68 6f 73 74 20 28 20 6b 65 79 20 75 20 ch-host ( key u
0ce0: 2d 2d 20 29 0a 20 20 20 20 6e 65 74 32 6f 2d 63 -- ). net2o-c
0cf0: 6f 64 65 0a 20 20 20 20 20 20 65 78 70 65 63 74 ode. expect
0d00: 2d 72 65 70 6c 79 20 67 65 74 2d 69 70 20 66 65 -reply get-ip fe
0d10: 74 63 68 2d 69 64 2c 20 63 6f 6f 6b 69 65 2b 72 tch-id, cookie+r
0d20: 65 71 75 65 73 74 0a 20 20 20 20 65 6e 64 2d 63 equest. end-c
0d30: 6f 64 65 7c 20 2d 73 65 74 69 70 20 3b 0a 0a 3a ode| -setip ;..:
0d40: 20 70 6b 3a 61 64 64 6d 65 2d 66 65 74 63 68 2d pk:addme-fetch-
0d50: 68 6f 73 74 20 28 20 6b 65 79 20 75 20 2d 2d 20 host ( key u --
0d60: 29 20 2b 61 64 64 6d 65 0a 20 20 20 20 6e 65 74 ) +addme. net
0d70: 32 6f 2d 63 6f 64 65 0a 20 20 20 20 20 20 65 78 2o-code. ex
0d80: 70 65 63 74 2d 72 65 70 6c 79 20 67 65 74 2d 69 pect-reply get-i
0d90: 70 20 66 65 74 63 68 2d 69 64 2c 20 72 65 70 6c p fetch-id, repl
0da0: 61 63 65 2d 6d 65 2c 0a 20 20 20 20 20 20 63 6f ace-me,. co
0db0: 6f 6b 69 65 2b 72 65 71 75 65 73 74 0a 20 20 20 okie+request.
0dc0: 20 65 6e 64 2d 63 6f 64 65 7c 20 2d 73 65 74 69 end-code| -seti
0dd0: 70 20 6e 65 74 32 6f 3a 73 65 6e 64 2d 72 65 70 p net2o:send-rep
0de0: 6c 61 63 65 20 20 61 6e 6e 6f 75 6e 63 65 64 20 lace announced
0df0: 6f 6e 20 3b 0a 0a 5c 20 4e 41 54 20 72 65 74 72 on ;..\ NAT retr
0e00: 61 76 65 72 73 61 6c 0a 0a 46 6f 72 77 61 72 64 aversal..Forward
0e10: 20 69 6e 73 65 72 74 2d 61 64 64 72 20 28 20 6f insert-addr ( o
0e20: 20 2d 2d 20 29 0a 0a 3a 20 72 65 6e 61 74 20 28 -- )..: renat (
0e30: 20 2d 2d 20 29 0a 20 20 20 20 5b 3a 20 6d 73 67 -- ). [: msg
0e40: 3a 70 65 65 72 73 5b 5d 20 24 40 20 62 6f 75 6e :peers[] $@ boun
0e50: 64 73 20 3f 44 4f 0a 09 20 20 49 20 40 20 3e 6f ds ?DO.. I @ >o
0e60: 20 6f 2d 62 65 61 63 6f 6e 20 70 69 6e 67 73 0a o-beacon pings.
0e70: 09 20 20 5c 20 21 21 46 49 58 4d 45 21 21 20 73 . \ !!FIXME!! s
0e80: 68 6f 75 6c 64 20 6d 61 79 62 65 20 64 6f 20 61 hould maybe do a
0e90: 20 72 65 2d 6c 6f 6f 6b 75 70 3f 0a 09 20 20 72 re-lookup?.. r
0ea0: 65 74 2d 61 64 64 72 20 24 31 30 20 65 72 61 73 et-addr $10 eras
0eb0: 65 20 20 64 65 73 74 2d 30 6b 65 79 20 64 65 73 e dest-0key des
0ec0: 74 2d 30 6b 65 79 3e 20 21 0a 09 20 20 70 75 6e t-0key> !.. pun
0ed0: 63 68 2d 61 64 64 72 73 20 24 40 20 62 6f 75 6e ch-addrs $@ boun
0ee0: 64 73 20 3f 44 4f 0a 09 20 20 20 20 20 20 49 20 ds ?DO.. I
0ef0: 40 20 69 6e 73 65 72 74 2d 61 64 64 72 20 49 46 @ insert-addr IF
0f00: 0a 09 09 20 20 6f 20 74 6f 20 63 6f 6e 6e 65 63 ... o to connec
0f10: 74 69 6f 6e 0a 09 09 20 20 6e 65 74 32 6f 2d 63 tion... net2o-c
0f20: 6f 64 65 20 6e 65 77 2d 72 65 71 75 65 73 74 20 ode new-request
0f30: 74 72 75 65 20 67 65 6e 2d 70 75 6e 63 68 6c 6f true gen-punchlo
0f40: 61 64 20 67 65 6e 2d 70 75 6e 63 68 0a 09 09 20 ad gen-punch...
0f50: 20 65 6e 64 2d 63 6f 64 65 0a 09 20 20 20 20 20 end-code..
0f60: 20 54 48 45 4e 0a 09 20 20 63 65 6c 6c 20 2b 4c THEN.. cell +L
0f70: 4f 4f 50 20 6f 3e 0a 20 20 20 20 20 20 63 65 6c OOP o>. cel
0f80: 6c 20 2b 4c 4f 4f 50 0a 20 20 20 20 3b 5d 20 67 l +LOOP. ;] g
0f90: 72 6f 75 70 23 6d 61 70 20 3b 0a 0a 5c 20 6e 6f roup#map ;..\ no
0fa0: 74 69 66 69 63 61 74 69 6f 6e 20 66 6f 72 20 61 tification for a
0fb0: 64 64 72 65 73 73 20 63 68 61 6e 67 65 73 0a 0a ddress changes..
0fc0: 5b 49 46 44 45 46 5d 20 61 6e 64 72 6f 69 64 20 [IFDEF] android
0fd0: 20 20 20 20 72 65 71 75 69 72 65 20 61 6e 64 72 require andr
0fe0: 6f 69 64 2f 6e 65 74 2e 66 73 20 20 5b 45 4c 53 oid/net.fs [ELS
0ff0: 45 5d 0a 20 20 20 20 5b 49 46 44 45 46 5d 20 50 E]. [IFDEF] P
1000: 46 5f 4e 45 54 4c 49 4e 4b 20 20 72 65 71 75 69 F_NETLINK requi
1010: 72 65 20 6c 69 6e 75 78 2f 6e 65 74 2e 66 73 20 re linux/net.fs
1020: 20 20 20 5b 54 48 45 4e 5d 0a 5b 54 48 45 4e 5d [THEN].[THEN]
1030: 0a 0a 5c 20 61 6e 6e 6f 75 6e 63 65 20 61 6e 64 ..\ announce and
1040: 20 72 65 6e 61 74 0a 0a 3a 20 61 6e 6e 6f 75 6e renat..: announ
1050: 63 65 2d 6d 65 20 28 20 2d 2d 20 29 0a 20 20 20 ce-me ( -- ).
1060: 20 5c 20 43 68 65 63 6b 20 66 6f 72 20 64 69 73 \ Check for dis
1070: 63 6f 6e 6e 65 63 74 65 64 20 73 74 61 74 65 0a connected state.
1080: 20 20 20 20 64 68 74 2d 63 6f 6e 6e 65 63 74 20 dht-connect
1090: 6f 6e 6c 69 6e 65 3f 20 49 46 0a 09 72 65 70 6c online? IF..repl
10a0: 61 63 65 2d 6d 65 20 2d 6f 74 68 65 72 20 20 61 ace-me -other a
10b0: 6e 6e 6f 75 6e 63 65 64 20 6f 6e 20 20 54 48 45 nnounced on THE
10c0: 4e 20 3b 0a 0a 3a 20 72 65 6e 61 74 2d 61 6c 6c N ;..: renat-all
10d0: 20 28 20 2d 2d 20 29 20 62 65 61 63 6f 6e 28 20 ( -- ) beacon(
10e0: 2e 22 20 72 65 6d 6f 76 65 20 61 6c 6c 20 62 65 ." remove all be
10f0: 61 63 6f 6e 73 22 20 63 72 20 29 0a 20 20 20 20 acons" cr ).
1100: 5b 49 46 44 45 46 5d 20 72 65 6e 61 74 2d 63 6f [IFDEF] renat-co
1110: 6d 70 6c 65 74 65 20 5b 3a 20 5b 54 48 45 4e 5d mplete [: [THEN]
1120: 0a 09 30 20 2e 21 6d 79 2d 61 64 64 72 20 64 68 ..0 .!my-addr dh
1130: 74 2d 64 69 73 63 6f 6e 6e 65 63 74 20 5c 20 6f t-disconnect \ o
1140: 6c 64 20 44 48 54 20 6d 61 79 20 62 65 20 73 74 ld DHT may be st
1150: 61 6c 65 0a 09 61 6e 6e 6f 75 6e 63 65 2d 6d 65 ale..announce-me
1160: 20 5c 20 69 66 20 77 65 20 73 75 63 63 65 65 64 \ if we succeed
1170: 20 68 65 72 65 2c 20 77 65 20 63 61 6e 20 74 72 here, we can tr
1180: 79 20 74 68 65 20 72 65 73 74 0a 09 62 65 61 63 y the rest..beac
1190: 6f 6e 73 23 20 23 66 72 65 65 73 0a 09 30 20 3e ons# #frees..0 >
11a0: 6f 20 64 68 74 72 6f 6f 74 20 2b 64 68 74 2d 62 o dhtroot +dht-b
11b0: 65 61 63 6f 6e 20 6f 3e 0a 09 72 65 6e 61 74 0a eacon o>..renat.
11c0: 20 20 20 20 5b 49 46 44 45 46 5d 20 72 65 6e 61 [IFDEF] rena
11d0: 74 2d 63 6f 6d 70 6c 65 74 65 20 3b 5d 20 63 61 t-complete ;] ca
11e0: 74 63 68 20 72 65 6e 61 74 2d 63 6f 6d 70 6c 65 tch renat-comple
11f0: 74 65 20 74 68 72 6f 77 20 5b 54 48 45 4e 5d 0a te throw [THEN].
1200: 20 20 20 20 62 65 61 63 6f 6e 28 20 2e 22 20 64 beacon( ." d
1210: 6f 6e 65 20 72 65 6e 61 74 22 20 63 72 20 29 20 one renat" cr )
1220: 3b 0a 0a 73 63 6f 70 65 7b 20 2f 63 68 61 74 0a ;..scope{ /chat.
1230: 3a 6e 6f 6e 61 6d 65 20 28 20 61 64 64 72 20 75 :noname ( addr u
1240: 20 2d 2d 20 29 20 72 65 6e 61 74 2d 61 6c 6c 20 -- ) renat-all
1250: 2f 6e 61 74 20 3b 20 69 73 20 2f 72 65 6e 61 74 /nat ; is /renat
1260: 0a 7d 73 63 6f 70 65 0a 0a 5c 20 62 65 61 63 6f .}scope..\ beaco
1270: 6e 20 68 61 6e 64 6c 69 6e 67 0a 0a 65 76 65 6e n handling..even
1280: 74 3a 20 3a 3e 64 6f 2d 62 65 61 63 6f 6e 20 28 t: :>do-beacon (
1290: 20 61 64 64 72 20 2d 2d 20 29 0a 20 20 20 20 62 addr -- ). b
12a0: 65 61 63 6f 6e 28 20 2e 22 20 3a 3e 64 6f 2d 62 eacon( ." :>do-b
12b0: 65 61 63 6f 6e 22 20 66 6f 72 74 68 3a 63 72 20 eacon" forth:cr
12c0: 29 0a 20 20 20 20 7b 20 62 65 61 63 6f 6e 20 7d ). { beacon }
12d0: 20 62 65 61 63 6f 6e 20 63 65 6c 6c 2b 20 24 40 beacon cell+ $@
12e0: 20 31 20 36 34 73 20 2f 73 74 72 69 6e 67 20 62 1 64s /string b
12f0: 6f 75 6e 64 73 20 3f 44 4f 0a 09 62 65 61 63 6f ounds ?DO..beaco
1300: 6e 20 24 40 20 49 20 32 40 20 2e 65 78 65 63 75 n $@ I 2@ .execu
1310: 74 65 0a 20 20 20 20 32 20 63 65 6c 6c 73 20 2b te. 2 cells +
1320: 4c 4f 4f 50 20 3b 0a 0a 3a 20 64 6f 2d 62 65 61 LOOP ;..: do-bea
1330: 63 6f 6e 20 28 20 61 64 64 72 20 2d 2d 20 29 20 con ( addr -- )
1340: 20 5c 20 73 69 67 6e 20 6f 6e 2c 20 61 6e 64 20 \ sign on, and
1350: 64 6f 20 61 20 72 65 70 6c 61 63 65 2d 6d 65 0a do a replace-me.
1360: 20 20 20 20 3c 65 76 65 6e 74 20 65 6c 69 74 2c <event elit,
1370: 20 3a 3e 64 6f 2d 62 65 61 63 6f 6e 20 3f 71 75 :>do-beacon ?qu
1380: 65 72 79 2d 74 61 73 6b 20 65 76 65 6e 74 3e 20 ery-task event>
1390: 3b 0a 0a 0a 56 61 72 69 61 62 6c 65 20 6d 79 2d ;...Variable my-
13a0: 62 65 61 63 6f 6e 0a 0a 3a 20 6d 79 2d 62 65 61 beacon..: my-bea
13b0: 63 6f 6e 2d 68 61 73 68 20 28 20 2d 2d 20 68 61 con-hash ( -- ha
13c0: 73 68 20 75 20 29 0a 20 20 20 20 6d 79 2d 62 65 sh u ). my-be
13d0: 61 63 6f 6e 20 24 40 20 64 75 70 20 3f 45 58 49 acon $@ dup ?EXI
13e0: 54 20 20 32 64 72 6f 70 0a 20 20 20 20 6d 79 2d T 2drop. my-
13f0: 30 6b 65 79 20 73 65 63 40 20 22 62 65 61 63 6f 0key sec@ "beaco
1400: 6e 22 20 6b 65 79 65 64 2d 68 61 73 68 23 31 32 n" keyed-hash#12
1410: 38 20 32 2f 20 6d 79 2d 62 65 61 63 6f 6e 20 24 8 2/ my-beacon $
1420: 21 0a 20 20 20 20 6d 79 2d 62 65 61 63 6f 6e 20 !. my-beacon
1430: 24 40 20 3b 0a 0a 3a 20 63 68 65 63 6b 2d 62 65 $@ ;..: check-be
1440: 61 63 6f 6e 2d 68 61 73 68 20 28 20 61 64 64 72 acon-hash ( addr
1450: 20 75 20 2d 2d 20 66 6c 61 67 20 29 0a 20 20 20 u -- flag ).
1460: 20 6d 79 2d 62 65 61 63 6f 6e 2d 68 61 73 68 20 my-beacon-hash
1470: 73 74 72 3d 20 3b 0a 0a 3a 20 63 68 65 63 6b 2d str= ;..: check-
1480: 70 75 6e 63 68 2d 68 61 73 68 20 28 20 61 64 64 punch-hash ( add
1490: 72 20 75 20 2d 2d 20 63 6f 6e 6e 65 63 74 69 6f r u -- connectio
14a0: 6e 2f 66 61 6c 73 65 20 29 0a 5c 20 20 20 20 32 n/false ).\ 2
14b0: 64 75 70 20 64 75 6d 70 0a 20 20 20 20 64 75 70 dup dump. dup
14c0: 20 24 31 38 20 3c 20 49 46 20 20 32 64 72 6f 70 $18 < IF 2drop
14d0: 20 66 61 6c 73 65 20 20 45 58 49 54 20 20 54 48 false EXIT TH
14e0: 45 4e 0a 20 20 20 20 6f 76 65 72 20 6c 65 2d 36 EN. over le-6
14f0: 34 40 20 3e 64 65 73 74 2d 6d 61 70 20 40 20 64 4@ >dest-map @ d
1500: 75 70 20 49 46 20 20 2e 70 61 72 65 6e 74 20 3e up IF .parent >
1510: 6f 0a 09 38 20 2f 73 74 72 69 6e 67 20 70 75 6e o..8 /string pun
1520: 63 68 23 20 6f 76 65 72 20 6b 65 79 7c 20 73 74 ch# over key| st
1530: 72 3d 20 6f 20 61 6e 64 20 6f 3e 0a 20 20 20 20 r= o and o>.
1540: 45 4c 53 45 20 20 6e 69 70 20 6e 69 70 20 20 54 ELSE nip nip T
1550: 48 45 4e 20 3b 0a 0a 0a 3a 20 3f 2d 62 65 61 63 HEN ;...: ?-beac
1560: 6f 6e 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 on ( addr u -- )
1570: 0a 20 20 20 20 5c 47 20 69 66 20 77 65 20 64 6f . \G if we do
1580: 6e 27 74 20 6b 6e 6f 77 20 74 68 61 74 20 61 64 n't know that ad
1590: 64 72 65 73 73 2c 20 73 65 6e 64 20 61 20 72 65 dress, send a re
15a0: 70 6c 79 0a 20 20 20 20 6e 65 65 64 2d 62 65 61 ply. need-bea
15b0: 63 6f 6e 23 20 40 20 49 46 0a 09 32 64 75 70 20 con# @ IF..2dup
15c0: 63 68 65 63 6b 2d 62 65 61 63 6f 6e 2d 68 61 73 check-beacon-has
15d0: 68 20 30 3d 20 49 46 0a 09 20 20 20 20 62 65 61 h 0= IF.. bea
15e0: 63 6f 6e 28 20 74 69 63 6b 73 20 2e 74 69 63 6b con( ticks .tick
15f0: 73 20 2e 22 20 20 77 72 6f 6e 67 20 62 65 61 63 s ." wrong beac
1600: 6f 6e 20 68 61 73 68 22 0a 09 20 20 20 20 38 35 on hash".. 85
1610: 74 79 70 65 20 2e 22 20 20 69 6e 73 74 65 61 64 type ." instead
1620: 20 6f 66 20 22 20 6d 79 2d 62 65 61 63 6f 6e 20 of " my-beacon
1630: 24 40 20 38 35 74 79 70 65 20 63 72 20 29 65 6c $@ 85type cr )el
1640: 73 65 28 20 32 64 72 6f 70 20 29 20 20 45 58 49 se( 2drop ) EXI
1650: 54 0a 09 54 48 45 4e 0a 20 20 20 20 54 48 45 4e T..THEN. THEN
1660: 20 20 32 64 72 6f 70 0a 20 20 20 20 6e 65 74 32 2drop. net2
1670: 6f 2d 73 6f 63 6b 0a 20 20 20 20 73 6f 63 6b 61 o-sock. socka
1680: 64 64 72 3c 20 61 6c 65 6e 20 40 20 72 6f 75 74 ddr< alen @ rout
1690: 65 73 23 20 23 40 20 6e 69 70 20 30 3d 20 49 46 es# #@ nip 0= IF
16a0: 20 20 22 21 22 20 20 45 4c 53 45 20 20 22 2e 22 "!" ELSE "."
16b0: 20 20 54 48 45 4e 0a 20 20 20 20 62 65 61 63 6f THEN. beaco
16c0: 6e 28 20 74 69 63 6b 73 20 2e 74 69 63 6b 73 20 n( ticks .ticks
16d0: 2e 22 20 20 53 65 6e 64 20 27 22 20 32 64 75 70 ." Send '" 2dup
16e0: 20 32 64 75 70 20 70 72 69 6e 74 61 62 6c 65 3f 2dup printable?
16f0: 20 49 46 20 20 74 79 70 65 20 20 45 4c 53 45 20 IF type ELSE
1700: 20 38 35 74 79 70 65 20 20 54 48 45 4e 0a 20 20 85type THEN.
1710: 20 20 2e 22 20 27 20 72 65 70 6c 79 20 74 6f 3a ." ' reply to:
1720: 20 22 20 73 6f 63 6b 61 64 64 72 3c 20 61 6c 65 " sockaddr< ale
1730: 6e 20 40 20 2e 61 64 64 72 65 73 73 20 66 6f 72 n @ .address for
1740: 74 68 3a 63 72 20 29 0a 20 20 20 20 30 20 73 6f th:cr ). 0 so
1750: 63 6b 61 64 64 72 3c 20 61 6c 65 6e 20 40 20 73 ckaddr< alen @ s
1760: 65 6e 64 74 6f 20 64 72 6f 70 20 2b 73 65 6e 64 endto drop +send
1770: 20 3b 0a 3a 20 21 2d 62 65 61 63 6f 6e 20 28 20 ;.: !-beacon (
1780: 61 64 64 72 20 75 20 2d 2d 20 29 20 32 64 72 6f addr u -- ) 2dro
1790: 70 0a 20 20 20 20 5c 47 20 49 20 67 6f 74 20 61 p. \G I got a
17a0: 20 72 65 70 6c 79 2c 20 6d 79 20 61 64 64 72 65 reply, my addre
17b0: 73 73 20 69 73 20 75 6e 6b 6e 6f 77 6e 0a 20 20 ss is unknown.
17c0: 20 20 62 65 61 63 6f 6e 28 20 74 69 63 6b 73 20 beacon( ticks
17d0: 2e 74 69 63 6b 73 20 2e 22 20 20 47 6f 74 20 75 .ticks ." Got u
17e0: 6e 6b 6e 6f 77 6e 20 72 65 70 6c 79 3a 20 22 20 nknown reply: "
17f0: 73 6f 63 6b 61 64 64 72 3c 20 61 6c 65 6e 20 40 sockaddr< alen @
1800: 20 2e 61 64 64 72 65 73 73 20 66 6f 72 74 68 3a .address forth:
1810: 63 72 20 29 0a 20 20 20 20 73 6f 63 6b 61 64 64 cr ). sockadd
1820: 72 3c 20 61 6c 65 6e 20 40 20 62 65 61 63 6f 6e r< alen @ beacon
1830: 73 23 20 23 40 20 64 30 3c 3e 20 49 46 20 20 6c s# #@ d0<> IF l
1840: 61 73 74 23 20 64 6f 2d 62 65 61 63 6f 6e 20 20 ast# do-beacon
1850: 54 48 45 4e 20 3b 0a 3a 20 2e 2d 62 65 61 63 6f THEN ;.: .-beaco
1860: 6e 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 20 n ( addr u -- )
1870: 32 64 72 6f 70 0a 20 20 20 20 5c 47 20 49 20 67 2drop. \G I g
1880: 6f 74 20 61 20 72 65 70 6c 79 2c 20 6d 79 20 61 ot a reply, my a
1890: 64 64 72 65 73 73 20 69 73 20 6b 6e 6f 77 6e 0a ddress is known.
18a0: 20 20 20 20 62 65 61 63 6f 6e 28 20 74 69 63 6b beacon( tick
18b0: 73 20 2e 74 69 63 6b 73 20 2e 22 20 20 47 6f 74 s .ticks ." Got
18c0: 20 6b 6e 6f 77 6e 20 72 65 70 6c 79 3a 20 22 20 known reply: "
18d0: 73 6f 63 6b 61 64 64 72 3c 20 61 6c 65 6e 20 40 sockaddr< alen @
18e0: 20 2e 61 64 64 72 65 73 73 20 66 6f 72 74 68 3a .address forth:
18f0: 63 72 20 29 0a 20 20 20 20 73 6f 63 6b 61 64 64 cr ). sockadd
1900: 72 3c 20 61 6c 65 6e 20 40 20 62 65 61 63 6f 6e r< alen @ beacon
1910: 73 23 20 23 40 20 49 46 0a 09 3e 72 20 72 40 20 s# #@ IF..>r r@
1920: 36 34 40 20 74 69 63 6b 73 20 36 34 75 6d 69 6e 64@ ticks 64umin
1930: 20 62 65 61 63 6f 6e 2d 74 69 63 6b 73 23 20 36 beacon-ticks# 6
1940: 34 2b 20 72 3e 20 36 34 21 0a 20 20 20 20 45 4c 4+ r> 64!. EL
1950: 53 45 20 20 64 72 6f 70 20 20 54 48 45 4e 20 3b SE drop THEN ;
1960: 0a 3a 20 3e 2d 62 65 61 63 6f 6e 20 28 20 61 64 .: >-beacon ( ad
1970: 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 5c 47 dr u -- ). \G
1980: 20 49 20 67 6f 74 20 61 20 70 75 6e 63 68 0a 20 I got a punch.
1990: 20 20 20 6e 61 74 28 20 74 69 63 6b 73 20 2e 74 nat( ticks .t
19a0: 69 63 6b 73 20 2e 22 20 20 47 6f 74 20 70 75 6e icks ." Got pun
19b0: 63 68 3a 20 22 20 73 6f 63 6b 61 64 64 72 3c 20 ch: " sockaddr<
19c0: 61 6c 65 6e 20 40 20 2e 61 64 64 72 65 73 73 20 alen @ .address
19d0: 66 6f 72 74 68 3a 63 72 20 29 0a 20 20 20 20 63 forth:cr ). c
19e0: 68 65 63 6b 2d 70 75 6e 63 68 2d 68 61 73 68 20 heck-punch-hash
19f0: 3f 64 75 70 2d 49 46 0a 09 5c 20 21 21 46 49 58 ?dup-IF..\ !!FIX
1a00: 4d 45 21 21 20 61 63 63 65 70 74 20 6f 6e 6c 79 ME!! accept only
1a10: 20 74 77 6f 3a 20 6f 6e 65 20 49 50 76 34 2c 20 two: one IPv4,
1a20: 6f 6e 65 20 49 50 76 36 2e 0a 09 5c 20 21 21 46 one IPv6...\ !!F
1a30: 49 58 4d 45 21 21 20 61 6e 64 20 74 72 79 20 6d IXME!! and try m
1a40: 65 72 67 69 6e 67 20 74 68 65 20 74 77 6f 20 69 erging the two i
1a50: 6e 74 6f 20 65 78 69 73 74 65 6e 74 0a 09 3e 6f nto existent..>o
1a60: 20 73 6f 63 6b 61 64 64 72 3c 20 61 6c 65 6e 20 sockaddr< alen
1a70: 40 20 6e 61 74 28 20 2e 22 20 2b 70 75 6e 63 68 @ nat( ." +punch
1a80: 20 22 20 32 64 75 70 20 2e 61 64 64 72 65 73 73 " 2dup .address
1a90: 20 66 6f 72 74 68 3a 63 72 20 29 0a 09 2e 73 6f forth:cr )...so
1aa0: 63 6b 61 64 64 72 20 6e 65 77 2d 61 64 64 72 20 ckaddr new-addr
1ab0: 70 75 6e 63 68 2d 61 64 64 72 73 20 3e 73 74 61 punch-addrs >sta
1ac0: 63 6b 20 6f 3e 0a 20 20 20 20 54 48 45 4e 20 3b ck o>. THEN ;
1ad0: 0a 0a 3a 20 68 61 6e 64 6c 65 2d 62 65 61 63 6f ..: handle-beaco
1ae0: 6e 20 28 20 61 64 64 72 20 75 20 63 68 61 72 20 n ( addr u char
1af0: 2d 2d 20 29 0a 20 20 20 20 63 61 73 65 0a 09 27 -- ). case..'
1b00: 3f 27 20 6f 66 20 20 3f 2d 62 65 61 63 6f 6e 20 ?' of ?-beacon
1b10: 20 65 6e 64 6f 66 0a 09 27 21 27 20 6f 66 20 20 endof..'!' of
1b20: 21 2d 62 65 61 63 6f 6e 20 20 65 6e 64 6f 66 0a !-beacon endof.
1b30: 09 27 2e 27 20 6f 66 20 20 2e 2d 62 65 61 63 6f .'.' of .-beaco
1b40: 6e 20 20 65 6e 64 6f 66 0a 09 27 3e 27 20 6f 66 n endof..'>' of
1b50: 20 20 3e 2d 62 65 61 63 6f 6e 20 20 65 6e 64 6f >-beacon endo
1b60: 66 0a 09 6e 69 70 0a 20 20 20 20 65 6e 64 63 61 f..nip. endca
1b70: 73 65 20 3b 0a 0a 3a 20 68 61 6e 64 6c 65 2d 62 se ;..: handle-b
1b80: 65 61 63 6f 6e 2b 68 61 73 68 20 28 20 61 64 64 eacon+hash ( add
1b90: 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 64 75 70 r u -- ). dup
1ba0: 20 49 46 20 20 6f 76 65 72 20 63 40 20 3e 72 20 IF over c@ >r
1bb0: 31 20 2f 73 74 72 69 6e 67 20 72 3e 20 68 61 6e 1 /string r> han
1bc0: 64 6c 65 2d 62 65 61 63 6f 6e 20 20 45 4c 53 45 dle-beacon ELSE
1bd0: 20 20 32 64 72 6f 70 20 20 54 48 45 4e 20 3b 0a 2drop THEN ;.
1be0: 0a 3a 20 72 65 70 6c 61 63 65 2d 6c 6f 6f 70 20 .: replace-loop
1bf0: 28 20 61 64 64 72 20 75 20 2d 2d 20 66 6c 61 67 ( addr u -- flag
1c00: 20 29 0a 20 20 20 20 42 45 47 49 4e 20 20 6b 65 ). BEGIN ke
1c10: 79 32 7c 20 3e 64 23 69 64 20 3e 6f 20 64 68 74 y2| >d#id >o dht
1c20: 2d 68 6f 73 74 20 24 5b 5d 23 20 49 46 20 20 30 -host $[]# IF 0
1c30: 20 64 68 74 2d 68 6f 73 74 20 24 5b 5d 40 20 20 dht-host $[]@
1c40: 45 4c 53 45 20 20 23 30 2e 20 20 54 48 45 4e 20 ELSE #0. THEN
1c50: 6f 3e 0a 09 32 64 75 70 20 64 30 3c 3e 20 57 48 o>..2dup d0<> WH
1c60: 49 4c 45 0a 09 20 20 20 20 6f 76 65 72 20 63 40 ILE.. over c@
1c70: 20 27 21 27 20 3d 20 57 48 49 4c 45 0a 09 09 72 '!' = WHILE...r
1c80: 65 70 6c 61 63 65 2d 6b 65 79 20 6f 3e 0a 09 09 eplace-key o>...
1c90: 63 6f 6e 6e 65 63 74 28 20 3e 6f 20 6b 65 2d 70 connect( >o ke-p
1ca0: 6b 20 24 40 20 2e 22 20 72 65 70 6c 61 63 65 20 k $@ ." replace
1cb0: 6b 65 79 3a 20 22 20 32 64 75 70 20 38 35 74 79 key: " 2dup 85ty
1cc0: 70 65 20 63 72 20 6f 20 6f 3e 20 29 0a 09 09 3e pe cr o o> )...>
1cd0: 72 20 32 64 75 70 20 63 3a 66 65 74 63 68 2d 69 r 2dup c:fetch-i
1ce0: 64 20 72 3e 20 3e 6f 20 20 52 45 50 45 41 54 20 d r> >o REPEAT
1cf0: 20 54 48 45 4e 20 20 64 30 3c 3e 20 3b 0a 0a 3a THEN d0<> ;..:
1d00: 20 70 6b 2d 71 75 65 72 79 20 28 20 61 64 64 72 pk-query ( addr
1d10: 20 75 20 78 74 20 2d 2d 20 66 6c 61 67 20 29 20 u xt -- flag )
1d20: 3e 72 0a 20 20 20 20 64 68 74 2d 63 6f 6e 6e 65 >r. dht-conne
1d30: 63 74 20 6f 6e 6c 69 6e 65 3f 20 49 46 20 20 32 ct online? IF 2
1d40: 64 75 70 20 72 3e 20 65 78 65 63 75 74 65 20 20 dup r> execute
1d50: 72 65 70 6c 61 63 65 2d 6c 6f 6f 70 0a 20 20 20 replace-loop.
1d60: 20 45 4c 53 45 20 20 32 64 72 6f 70 20 72 64 72 ELSE 2drop rdr
1d70: 6f 70 20 66 61 6c 73 65 20 20 54 48 45 4e 20 3b op false THEN ;
1d80: 0a 0a 3a 20 70 6b 2d 6c 6f 6f 6b 75 70 20 28 20 ..: pk-lookup (
1d90: 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 addr u -- ).
1da0: 5b 27 5d 20 70 6b 3a 66 65 74 63 68 2d 68 6f 73 ['] pk:fetch-hos
1db0: 74 20 20 5b 27 5d 20 70 6b 3a 61 64 64 6d 65 2d t ['] pk:addme-
1dc0: 66 65 74 63 68 2d 68 6f 73 74 20 20 61 6e 6e 6f fetch-host anno
1dd0: 75 6e 63 65 64 20 40 20 73 65 6c 65 63 74 0a 20 unced @ select.
1de0: 20 20 20 70 6b 2d 71 75 65 72 79 20 30 3d 20 21 pk-query 0= !
1df0: 21 68 6f 73 74 2d 6e 6f 74 66 6f 75 6e 64 21 21 !host-notfound!!
1e00: 20 3b 0a 0a 3a 20 70 6b 2d 70 65 65 6b 3f 20 28 ;..: pk-peek? (
1e10: 20 70 6b 20 75 20 2d 2d 20 66 6c 61 67 20 29 20 pk u -- flag )
1e20: 20 5b 27 5d 20 70 6b 3a 66 65 74 63 68 2d 68 6f ['] pk:fetch-ho
1e30: 73 74 20 70 6b 2d 71 75 65 72 79 20 3b 0a 0a 55 st pk-query ;..U
1e40: 73 65 72 20 68 6f 73 74 63 24 20 5c 20 63 68 65 ser hostc$ \ che
1e50: 63 6b 20 66 6f 72 20 74 68 69 73 20 68 6f 73 74 ck for this host
1e60: 6e 61 6d 65 0a 0a 3a 20 63 68 65 63 6b 2d 68 6f name..: check-ho
1e70: 73 74 3f 20 28 20 6f 20 61 64 64 72 20 75 20 2d st? ( o addr u -
1e80: 2d 20 6f 20 61 64 64 72 27 20 75 20 66 6c 61 67 - o addr' u flag
1e90: 20 29 0a 20 20 20 20 32 20 70 69 63 6b 20 2e 68 ). 2 pick .h
1ea0: 6f 73 74 3e 24 20 3b 0a 0a 30 20 56 61 6c 75 65 ost>$ ;..0 Value
1eb0: 20 3f 6d 79 73 65 6c 66 0a 0a 3a 20 6d 79 68 6f ?myself..: myho
1ec0: 73 74 3d 20 28 20 6f 20 2d 2d 20 66 6c 61 67 20 st= ( o -- flag
1ed0: 29 0a 20 20 20 20 2e 68 6f 73 74 3a 69 64 20 24 ). .host:id $
1ee0: 40 20 68 6f 73 74 24 20 24 40 20 73 74 72 3d 20 @ host$ $@ str=
1ef0: 3f 6d 79 73 65 6c 66 20 61 6e 64 20 3b 0a 20 20 ?myself and ;.
1f00: 20 20 0a 3a 20 68 6f 73 74 3d 20 28 20 6f 20 2d .: host= ( o -
1f10: 2d 20 66 6c 61 67 20 29 0a 20 20 20 20 3e 6f 20 - flag ). >o
1f20: 68 6f 73 74 63 24 20 24 40 20 64 75 70 20 49 46 hostc$ $@ dup IF
1f30: 20 20 68 6f 73 74 3a 69 64 20 24 40 20 73 74 72 host:id $@ str
1f40: 3d 20 20 45 4c 53 45 20 20 32 64 72 6f 70 20 74 = ELSE 2drop t
1f50: 72 75 65 20 20 54 48 45 4e 20 20 6f 3e 20 3b 0a rue THEN o> ;.
1f60: 0a 3a 20 69 6e 73 65 72 74 2d 61 64 64 72 20 28 .: insert-addr (
1f70: 20 6f 20 2d 2d 20 66 6c 61 67 20 29 0a 20 20 20 o -- flag ).
1f80: 20 63 6f 6e 6e 65 63 74 28 20 2e 22 20 63 68 65 connect( ." che
1f90: 63 6b 20 61 64 64 72 3a 20 22 20 64 75 70 20 2e ck addr: " dup .
1fa0: 61 64 64 72 20 63 72 20 29 20 20 66 61 6c 73 65 addr cr ) false
1fb0: 20 73 77 61 70 0a 20 20 20 20 5b 3a 20 63 68 65 swap. [: che
1fc0: 63 6b 2d 61 64 64 72 31 20 30 3d 20 49 46 20 20 ck-addr1 0= IF
1fd0: 32 64 72 6f 70 20 45 58 49 54 20 20 54 48 45 4e 2drop EXIT THEN
1fe0: 0a 20 20 20 20 20 20 69 6e 73 65 72 74 2d 61 64 . insert-ad
1ff0: 64 72 65 73 73 20 74 65 6d 70 2d 61 64 64 72 20 dress temp-addr
2000: 69 6e 73 2d 64 65 73 74 0a 20 20 20 20 20 20 63 ins-dest. c
2010: 6f 6e 6e 65 63 74 28 20 2e 22 20 69 6e 73 65 72 onnect( ." inser
2020: 74 20 68 6f 73 74 3a 20 22 20 74 65 6d 70 2d 61 t host: " temp-a
2030: 64 64 72 20 2e 61 64 64 72 2d 70 61 74 68 20 63 ddr .addr-path c
2040: 72 20 29 0a 20 20 20 20 20 20 72 65 74 2d 61 64 r ). ret-ad
2050: 64 72 20 24 31 30 20 30 20 73 6b 69 70 20 6e 69 dr $10 0 skip ni
2060: 70 20 30 3d 20 49 46 0a 09 20 20 74 65 6d 70 2d p 0= IF.. temp-
2070: 61 64 64 72 20 72 65 74 2d 61 64 64 72 20 24 31 addr ret-addr $1
2080: 30 20 6d 6f 76 65 0a 20 20 20 20 20 20 54 48 45 0 move. THE
2090: 4e 20 20 21 30 6b 65 79 20 20 64 72 6f 70 20 74 N !0key drop t
20a0: 72 75 65 20 3b 5d 20 61 64 64 72 3e 73 6f 63 6b rue ;] addr>sock
20b0: 20 3b 0a 0a 3a 20 69 6e 73 65 72 74 2d 61 64 64 ;..: insert-add
20c0: 72 24 20 28 20 61 64 64 72 20 75 20 2d 2d 20 66 r$ ( addr u -- f
20d0: 6c 61 67 20 29 20 20 64 65 73 74 2d 30 6b 65 79 lag ) dest-0key
20e0: 20 64 65 73 74 2d 30 6b 65 79 3e 20 21 0a 20 20 dest-0key> !.
20f0: 20 20 6e 65 77 2d 61 64 64 72 20 64 75 70 20 69 new-addr dup i
2100: 6e 73 65 72 74 2d 61 64 64 72 20 73 77 61 70 20 nsert-addr swap
2110: 2e 6e 65 74 32 6f 3a 64 69 73 70 6f 73 65 2d 61 .net2o:dispose-a
2120: 64 64 72 20 3b 0a 0a 3a 20 69 6e 73 65 72 74 2d ddr ;..: insert-
2130: 68 6f 73 74 20 28 20 61 64 64 72 20 75 20 2d 2d host ( addr u --
2140: 20 66 6c 61 67 20 29 20 20 64 65 73 74 2d 30 6b flag ) dest-0k
2150: 65 79 20 64 65 73 74 2d 30 6b 65 79 3e 20 21 0a ey dest-0key> !.
2160: 20 20 20 20 6e 65 77 2d 61 64 64 72 20 20 64 75 new-addr du
2170: 70 20 68 6f 73 74 3d 20 20 6f 76 65 72 20 6d 79 p host= over my
2180: 68 6f 73 74 3d 20 30 3d 20 61 6e 64 20 20 49 46 host= 0= and IF
2190: 0a 09 6d 73 67 28 20 2e 22 20 69 6e 73 65 72 74 ..msg( ." insert
21a0: 3a 20 22 20 64 75 70 20 2e 68 6f 73 74 3a 69 64 : " dup .host:id
21b0: 20 24 40 20 74 79 70 65 20 63 72 20 29 0a 09 64 $@ type cr )..d
21c0: 75 70 20 69 6e 73 65 72 74 2d 61 64 64 72 20 20 up insert-addr
21d0: 45 4c 53 45 20 20 66 61 6c 73 65 20 20 54 48 45 ELSE false THE
21e0: 4e 0a 20 20 20 20 73 77 61 70 20 2e 6e 65 74 32 N. swap .net2
21f0: 6f 3a 64 69 73 70 6f 73 65 2d 61 64 64 72 20 3b o:dispose-addr ;
2200: 0a 0a 3a 20 69 6e 73 65 72 74 2d 68 6f 73 74 3f ..: insert-host?
2210: 20 28 20 66 6c 61 67 20 6f 20 61 64 64 72 20 75 ( flag o addr u
2220: 20 2d 2d 20 66 6c 61 67 27 20 6f 20 29 0a 20 20 -- flag' o ).
2230: 20 20 33 20 70 69 63 6b 20 49 46 20 20 32 64 72 3 pick IF 2dr
2240: 6f 70 20 20 45 58 49 54 20 20 54 48 45 4e 0a 20 op EXIT THEN.
2250: 20 20 20 63 68 65 63 6b 2d 68 6f 73 74 3f 20 49 check-host? I
2260: 46 20 20 69 6e 73 65 72 74 2d 68 6f 73 74 20 20 F insert-host
2270: 45 4c 53 45 20 20 32 64 72 6f 70 20 66 61 6c 73 ELSE 2drop fals
2280: 65 20 20 54 48 45 4e 0a 20 20 20 20 72 6f 74 20 e THEN. rot
2290: 6f 72 20 73 77 61 70 20 3b 0a 0a 3a 20 6d 61 6b or swap ;..: mak
22a0: 65 2d 63 6f 6e 74 65 78 74 20 28 20 70 6b 20 75 e-context ( pk u
22b0: 20 2d 2d 20 29 0a 20 20 20 20 72 65 74 30 20 6e -- ). ret0 n
22c0: 65 74 32 6f 3a 6e 65 77 2d 63 6f 6e 74 65 78 74 et2o:new-context
22d0: 20 3e 6f 20 72 64 72 6f 70 20 64 65 73 74 2d 70 >o rdrop dest-p
22e0: 6b 20 3b 0a 0a 69 6e 20 6e 65 74 32 6f 20 3a 20 k ;..in net2o :
22f0: 70 6b 6c 6f 6f 6b 75 70 3f 20 28 20 70 6b 61 64 pklookup? ( pkad
2300: 64 72 20 75 20 2d 2d 20 66 6c 61 67 20 29 0a 20 dr u -- flag ).
2310: 20 20 20 32 64 75 70 20 6b 65 79 73 69 7a 65 32 2dup keysize2
2320: 20 73 61 66 65 2f 73 74 72 69 6e 67 20 68 6f 73 safe/string hos
2330: 74 63 24 20 24 21 20 6b 65 79 32 7c 20 32 64 75 tc$ $! key2| 2du
2340: 70 20 70 6b 63 20 6f 76 65 72 20 73 74 72 3d 20 p pkc over str=
2350: 74 6f 20 3f 6d 79 73 65 6c 66 0a 20 20 20 20 32 to ?myself. 2
2360: 64 75 70 20 3e 64 23 69 64 20 7b 20 69 64 20 7d dup >d#id { id }
2370: 0a 20 20 20 20 69 64 20 2e 64 68 74 2d 68 6f 73 . id .dht-hos
2380: 74 20 24 5b 5d 23 20 30 3d 20 49 46 20 20 32 64 t $[]# 0= IF 2d
2390: 75 70 20 70 6b 2d 6c 6f 6f 6b 75 70 20 20 32 64 up pk-lookup 2d
23a0: 75 70 20 3e 64 23 69 64 20 74 6f 20 69 64 20 20 up >d#id to id
23b0: 54 48 45 4e 0a 20 20 20 20 32 64 75 70 20 6d 61 THEN. 2dup ma
23c0: 6b 65 2d 63 6f 6e 74 65 78 74 0a 20 20 20 20 66 ke-context. f
23d0: 61 6c 73 65 20 69 64 20 64 75 70 20 2e 64 68 74 alse id dup .dht
23e0: 2d 68 6f 73 74 20 5b 27 5d 20 69 6e 73 65 72 74 -host ['] insert
23f0: 2d 68 6f 73 74 3f 20 24 5b 5d 6d 61 70 20 64 72 -host? $[]map dr
2400: 6f 70 20 6e 69 70 20 6e 69 70 20 3b 0a 69 6e 20 op nip nip ;.in
2410: 6e 65 74 32 6f 20 3a 20 70 6b 6c 6f 6f 6b 75 70 net2o : pklookup
2420: 20 28 20 70 6b 61 64 64 72 20 75 20 2d 2d 20 29 ( pkaddr u -- )
2430: 0a 20 20 20 20 6e 65 74 32 6f 3a 70 6b 6c 6f 6f . net2o:pkloo
2440: 6b 75 70 3f 20 30 3d 20 21 21 6e 6f 2d 61 64 64 kup? 0= !!no-add
2450: 72 65 73 73 21 21 20 3b 0a 0a 3a 20 3f 6e 61 74 ress!! ;..: ?nat
2460: 2d 64 6f 6e 65 20 28 20 6e 20 2d 2d 20 29 0a 20 -done ( n -- ).
2470: 20 20 20 6e 61 74 28 20 2e 22 20 72 65 71 20 64 nat( ." req d
2480: 6f 6e 65 2c 20 69 73 73 75 65 20 6e 61 74 20 72 one, issue nat r
2490: 65 71 75 65 73 74 22 20 66 6f 72 74 68 3a 63 72 equest" forth:cr
24a0: 20 29 0a 20 20 20 20 63 6f 6e 6e 65 63 74 2d 72 ). connect-r
24b0: 65 73 74 20 2b 66 6c 6f 77 2d 63 6f 6e 74 72 6f est +flow-contro
24c0: 6c 20 2b 72 65 73 65 6e 64 20 3f 6e 61 74 20 3b l +resend ?nat ;
24d0: 0a 3a 20 6e 6f 2d 6e 61 74 2d 64 6f 6e 65 20 28 .: no-nat-done (
24e0: 20 6e 20 2d 2d 20 29 0a 20 20 20 20 6e 61 74 28 n -- ). nat(
24f0: 20 2e 22 20 72 65 71 20 64 6f 6e 65 2c 20 66 69 ." req done, fi
2500: 6e 69 73 68 65 64 22 20 66 6f 72 74 68 3a 63 72 nished" forth:cr
2510: 20 29 0a 20 20 20 20 63 6f 6e 6e 65 63 74 2d 72 ). connect-r
2520: 65 73 74 20 2b 66 6c 6f 77 2d 63 6f 6e 74 72 6f est +flow-contro
2530: 6c 20 2b 72 65 73 65 6e 64 20 3b 0a 3a 20 64 69 l +resend ;.: di
2540: 72 65 63 74 2d 63 6f 6e 6e 65 63 74 20 28 20 63 rect-connect ( c
2550: 6d 64 6c 65 6e 20 64 61 74 61 6c 65 6e 20 2d 2d mdlen datalen --
2560: 20 29 0a 20 20 20 20 63 6d 64 30 28 20 2e 22 20 ). cmd0( ."
2570: 61 74 74 65 6d 70 74 20 74 6f 20 63 6f 6e 6e 65 attempt to conne
2580: 63 74 20 74 6f 3a 20 22 20 72 65 74 75 72 6e 2d ct to: " return-
2590: 61 64 64 72 20 2e 61 64 64 72 2d 70 61 74 68 20 addr .addr-path
25a0: 63 72 20 29 0a 20 20 20 20 5b 27 5d 20 3f 6e 61 cr ). ['] ?na
25b0: 74 2d 64 6f 6e 65 20 5b 27 5d 20 6e 6f 2d 6e 61 t-done ['] no-na
25c0: 74 2d 64 6f 6e 65 20 69 6e 64 2d 61 64 64 72 20 t-done ind-addr
25d0: 40 20 73 65 6c 65 63 74 20 72 71 64 3f 0a 20 20 @ select rqd?.
25e0: 20 20 6e 65 74 32 6f 3a 63 6f 6e 6e 65 63 74 20 net2o:connect
25f0: 6e 61 74 28 20 2e 22 20 63 6f 6e 6e 65 63 74 65 nat( ." connecte
2600: 64 22 20 66 6f 72 74 68 3a 63 72 20 29 20 3b 0a d" forth:cr ) ;.
2610: 0a 3a 20 70 6b 2d 63 6f 6e 6e 65 63 74 20 28 20 .: pk-connect (
2620: 61 64 64 72 20 75 20 63 6d 64 6c 65 6e 20 64 61 addr u cmdlen da
2630: 74 61 6c 65 6e 20 2d 2d 20 29 0a 20 20 20 20 32 talen -- ). 2
2640: 3e 72 20 6e 65 74 32 6f 3a 70 6b 6c 6f 6f 6b 75 >r net2o:pklooku
2650: 70 20 32 72 3e 20 64 69 72 65 63 74 2d 63 6f 6e p 2r> direct-con
2660: 6e 65 63 74 20 3b 0a 3a 20 70 6b 2d 63 6f 6e 6e nect ;.: pk-conn
2670: 65 63 74 3f 20 28 20 61 64 64 72 20 75 20 63 6d ect? ( addr u cm
2680: 64 6c 65 6e 20 64 61 74 61 6c 65 6e 20 2d 2d 20 dlen datalen --
2690: 66 6c 61 67 20 29 0a 20 20 20 20 32 3e 72 20 6e flag ). 2>r n
26a0: 65 74 32 6f 3a 70 6b 6c 6f 6f 6b 75 70 3f 20 64 et2o:pklookup? d
26b0: 75 70 20 49 46 20 20 20 32 72 3e 20 64 69 72 65 up IF 2r> dire
26c0: 63 74 2d 63 6f 6e 6e 65 63 74 20 20 45 4c 53 45 ct-connect ELSE
26d0: 20 20 32 72 64 72 6f 70 20 20 54 48 45 4e 20 3b 2rdrop THEN ;
26e0: 0a 0a 3a 20 61 64 64 72 2d 63 6f 6e 6e 65 63 74 ..: addr-connect
26f0: 20 28 20 61 64 64 72 2b 6b 65 79 20 75 20 63 6d ( addr+key u cm
2700: 64 6c 65 6e 20 64 61 74 61 6c 65 6e 20 78 74 20 dlen datalen xt
2710: 2d 2d 20 29 0a 20 20 20 20 2d 72 6f 74 20 32 3e -- ). -rot 2>
2720: 72 20 3e 72 20 6f 76 65 72 20 2b 20 31 2d 20 64 r >r over + 1- d
2730: 75 70 20 63 40 20 64 75 70 20 3e 72 20 2d 0a 20 up c@ dup >r -.
2740: 20 20 20 32 64 75 70 20 75 3e 3d 20 21 21 6b 65 2dup u>= !!ke
2750: 79 73 69 7a 65 21 21 0a 20 20 20 20 64 75 70 20 ysize!!. dup
2760: 72 3e 20 6d 61 6b 65 2d 63 6f 6e 74 65 78 74 0a r> make-context.
2770: 20 20 20 20 6f 76 65 72 20 2d 20 69 6e 73 65 72 over - inser
2780: 74 2d 61 64 64 72 24 20 30 3d 20 21 21 6e 6f 2d t-addr$ 0= !!no-
2790: 61 64 64 72 65 73 73 21 21 0a 20 20 20 20 72 3e address!!. r>
27a0: 20 65 78 65 63 75 74 65 20 32 72 3e 20 6e 65 74 execute 2r> net
27b0: 32 6f 3a 63 6f 6e 6e 65 63 74 20 3b 0a 0a 3a 20 2o:connect ;..:
27c0: 6e 69 63 6b 2d 63 6f 6e 6e 65 63 74 20 28 20 61 nick-connect ( a
27d0: 64 64 72 20 75 20 63 6d 64 6c 65 6e 20 64 61 74 ddr u cmdlen dat
27e0: 61 6c 65 6e 20 2d 2d 20 29 0a 20 20 20 20 32 3e alen -- ). 2>
27f0: 72 20 68 6f 73 74 2e 6e 69 63 6b 3e 70 6b 20 32 r host.nick>pk 2
2800: 72 3e 20 70 6b 2d 63 6f 6e 6e 65 63 74 20 3b 0a r> pk-connect ;.
2810: 0a 5c 20 73 65 61 72 63 68 20 6b 65 79 73 0a 0a .\ search keys..
2820: 55 73 65 72 20 73 65 61 72 63 68 2d 6b 65 79 5b User search-key[
2830: 5d 0a 55 73 65 72 20 70 69 6e 67 73 5b 5d 0a 0a ].User pings[]..
2840: 3a 20 73 65 61 72 63 68 2d 6b 65 79 73 20 28 20 : search-keys (
2850: 2d 2d 20 29 0a 20 20 20 20 64 68 74 2d 63 6f 6e -- ). dht-con
2860: 6e 65 63 74 0a 20 20 20 20 6e 65 74 32 6f 2d 63 nect. net2o-c
2870: 6f 64 65 20 20 65 78 70 65 63 74 2d 72 65 70 6c ode expect-repl
2880: 79 0a 20 20 20 20 73 65 61 72 63 68 2d 6b 65 79 y. search-key
2890: 5b 5d 20 5b 3a 20 24 2c 20 64 68 74 2d 69 64 20 [] [: $, dht-id
28a0: 64 68 74 2d 6f 77 6e 65 72 3f 20 65 6e 64 2d 77 dht-owner? end-w
28b0: 69 74 68 20 3b 5d 20 24 5b 5d 6d 61 70 0a 20 20 ith ;] $[]map.
28c0: 20 20 63 6f 6f 6b 69 65 2b 72 65 71 75 65 73 74 cookie+request
28d0: 20 65 6e 64 2d 63 6f 64 65 7c 20 3b 0a 0a 3a 20 end-code| ;..:
28e0: 73 65 61 72 63 68 2d 61 64 64 72 73 20 28 20 2d search-addrs ( -
28f0: 2d 20 29 0a 20 20 20 20 64 68 74 2d 63 6f 6e 6e - ). dht-conn
2900: 65 63 74 0a 20 20 20 20 6e 65 74 32 6f 2d 63 6f ect. net2o-co
2910: 64 65 20 20 65 78 70 65 63 74 2d 72 65 70 6c 79 de expect-reply
2920: 0a 20 20 20 20 73 65 61 72 63 68 2d 6b 65 79 5b . search-key[
2930: 5d 20 5b 3a 20 24 2c 20 64 68 74 2d 69 64 20 64 ] [: $, dht-id d
2940: 68 74 2d 68 6f 73 74 3f 20 65 6e 64 2d 77 69 74 ht-host? end-wit
2950: 68 20 3b 5d 20 24 5b 5d 6d 61 70 0a 20 20 20 20 h ;] $[]map.
2960: 63 6f 6f 6b 69 65 2b 72 65 71 75 65 73 74 20 65 cookie+request e
2970: 6e 64 2d 63 6f 64 65 7c 20 3b 0a 0a 3a 20 69 6e nd-code| ;..: in
2980: 73 65 72 74 2d 6b 65 79 73 20 28 20 2d 2d 20 29 sert-keys ( -- )
2990: 0a 20 20 20 20 64 65 66 61 75 6c 74 6b 65 79 20 . defaultkey
29a0: 40 20 3e 73 74 6f 72 65 6b 65 79 20 21 0a 20 20 @ >storekey !.
29b0: 20 20 69 6d 70 6f 72 74 23 64 68 74 20 69 6d 70 import#dht imp
29c0: 6f 72 74 2d 74 79 70 65 20 21 0a 20 20 20 20 73 ort-type !. s
29d0: 65 61 72 63 68 2d 6b 65 79 5b 5d 20 5b 3a 20 3e earch-key[] [: >
29e0: 64 23 69 64 20 3e 6f 0a 20 20 20 20 20 20 30 20 d#id >o. 0
29f0: 64 68 74 2d 6f 77 6e 65 72 20 24 5b 5d 40 20 6e dht-owner $[]@ n
2a00: 69 70 20 73 69 67 73 69 7a 65 23 20 75 3e 20 49 ip sigsize# u> I
2a10: 46 0a 09 20 20 36 34 23 2d 31 20 6b 65 79 2d 72 F.. 64#-1 key-r
2a20: 65 61 64 2d 6f 66 66 73 65 74 20 36 34 21 0a 09 ead-offset 64!..
2a30: 20 20 5b 3a 20 30 20 64 68 74 2d 6f 77 6e 65 72 [: 0 dht-owner
2a40: 20 24 5b 5d 40 20 32 64 75 70 20 73 69 67 73 69 $[]@ 2dup sigsi
2a50: 7a 65 23 20 2d 20 74 75 63 6b 20 74 79 70 65 20 ze# - tuck type
2a60: 2f 73 74 72 69 6e 67 0a 09 20 20 20 20 64 68 74 /string.. dht
2a70: 2d 68 61 73 68 20 24 2e 20 74 79 70 65 20 3b 5d -hash $. type ;]
2a80: 20 24 74 6d 70 0a 09 20 20 6b 65 79 3a 6e 65 73 $tmp.. key:nes
2a90: 74 2d 73 69 67 20 30 3d 20 49 46 20 20 64 6f 2d t-sig 0= IF do-
2aa0: 6e 65 73 74 73 69 67 0a 09 20 20 20 20 20 20 70 nestsig.. p
2ab0: 65 72 6d 25 64 65 66 61 75 6c 74 20 6b 65 2d 6d erm%default ke-m
2ac0: 61 73 6b 20 21 20 6e 3a 6f 3e 20 20 45 4c 53 45 ask ! n:o> ELSE
2ad0: 20 20 32 64 72 6f 70 20 20 54 48 45 4e 0a 20 20 2drop THEN.
2ae0: 20 20 20 20 54 48 45 4e 0a 20 20 20 20 20 20 6f THEN. o
2af0: 3e 20 3b 5d 20 24 5b 5d 6d 61 70 20 3b 0a 0a 3a > ;] $[]map ;..:
2b00: 20 73 65 6e 64 2d 70 69 6e 67 20 28 20 61 64 64 send-ping ( add
2b10: 72 20 75 20 2d 2d 20 29 20 73 69 67 73 69 7a 65 r u -- ) sigsize
2b20: 23 20 2d 20 6e 65 77 2d 61 64 64 72 20 64 75 70 # - new-addr dup
2b30: 20 3e 72 0a 20 20 20 20 5b 3a 20 72 65 74 2d 61 >r. [: ret-a
2b40: 64 64 72 20 24 31 30 20 65 72 61 73 65 0a 09 63 ddr $10 erase..c
2b50: 68 65 63 6b 2d 61 64 64 72 31 20 49 46 0a 09 20 heck-addr1 IF..
2b60: 20 20 20 32 64 75 70 20 2e 61 64 64 72 65 73 73 2dup .address
2b70: 20 66 6f 72 74 68 3a 63 72 0a 09 20 20 20 20 69 forth:cr.. i
2b80: 6e 73 65 72 74 2d 61 64 64 72 65 73 73 20 72 65 nsert-address re
2b90: 74 2d 61 64 64 72 20 69 6e 73 2d 64 65 73 74 0a t-addr ins-dest.
2ba0: 09 20 20 20 20 6e 65 74 32 6f 2d 63 6f 64 65 30 . net2o-code0
2bb0: 20 6e 65 74 32 6f 2d 76 65 72 73 69 6f 6e 20 24 net2o-version $
2bc0: 2c 20 76 65 72 73 69 6f 6e 3f 0a 09 20 20 20 20 , version?..
2bd0: 65 6e 64 2d 63 6f 64 65 0a 09 45 4c 53 45 20 20 end-code..ELSE
2be0: 32 64 72 6f 70 20 20 54 48 45 4e 20 3b 5d 20 61 2drop THEN ;] a
2bf0: 64 64 72 3e 73 6f 63 6b 0a 20 20 20 20 72 3e 20 ddr>sock. r>
2c00: 2e 6e 65 74 32 6f 3a 64 69 73 70 6f 73 65 2d 61 .net2o:dispose-a
2c10: 64 64 72 20 3b 0a 0a 3a 20 72 65 63 65 69 76 65 ddr ;..: receive
2c20: 2d 70 69 6e 67 73 20 28 20 2d 2d 20 29 0a 20 20 -pings ( -- ).
2c30: 20 20 72 65 71 75 65 73 74 73 2d 3e 30 20 3b 0a requests->0 ;.
2c40: 0a 3a 20 64 68 74 2d 6e 69 63 6b 3f 20 28 20 70 .: dht-nick? ( p
2c50: 6b 20 75 20 2d 2d 20 29 0a 20 20 20 20 64 75 70 k u -- ). dup
2c60: 20 34 20 3c 20 49 46 20 20 32 64 72 6f 70 20 20 4 < IF 2drop
2c70: 45 58 49 54 20 20 54 48 45 4e 0a 20 20 20 20 73 EXIT THEN. s
2c80: 65 61 72 63 68 2d 6b 65 79 5b 5d 20 24 6f 66 66 earch-key[] $off
2c90: 20 73 65 61 72 63 68 2d 6b 65 79 5b 5d 20 24 2b search-key[] $+
2ca0: 5b 5d 21 0a 20 20 20 20 73 65 61 72 63 68 2d 6b []!. search-k
2cb0: 65 79 73 20 69 6e 73 65 72 74 2d 6b 65 79 73 20 eys insert-keys
2cc0: 73 61 76 65 2d 70 75 62 6b 65 79 73 20 3b 0a 0a save-pubkeys ;..
2cd0: 5c 20 63 6f 6e 6e 65 63 74 2c 20 64 69 73 63 6f \ connect, disco
2ce0: 6e 6e 65 63 74 20 64 65 62 75 67 0a 0a 3a 20 64 nnect debug..: d
2cf0: 62 67 2d 63 6f 6e 6e 65 63 74 20 28 20 2d 2d 20 bg-connect ( --
2d00: 29 20 20 63 6f 6e 6e 65 63 74 28 20 3c 69 6e 66 ) connect( <inf
2d10: 6f 3e 0a 20 20 20 20 2e 22 20 63 6f 6e 6e 65 63 o>. ." connec
2d20: 74 65 64 20 66 72 6f 6d 3a 20 22 20 2e 63 6f 6e ted from: " .con
2d30: 2d 69 64 20 3c 64 65 66 61 75 6c 74 3e 20 63 72 -id <default> cr
2d40: 20 29 20 3b 0a 3a 20 64 62 67 2d 64 69 73 63 6f ) ;.: dbg-disco
2d50: 6e 6e 65 63 74 20 28 20 2d 2d 20 29 20 63 6f 6e nnect ( -- ) con
2d60: 6e 65 63 74 28 20 3c 69 6e 66 6f 3e 0a 20 20 20 nect( <info>.
2d70: 20 2e 22 20 64 69 73 63 6f 6e 6e 65 63 74 69 6e ." disconnectin
2d80: 67 3a 20 22 20 2e 63 6f 6e 2d 69 64 20 3c 64 65 g: " .con-id <de
2d90: 66 61 75 6c 74 3e 20 63 72 20 29 20 3b 0a 27 20 fault> cr ) ;.'
2da0: 64 62 67 2d 63 6f 6e 6e 65 63 74 20 49 53 20 64 dbg-connect IS d
2db0: 6f 2d 63 6f 6e 6e 65 63 74 0a 27 20 64 62 67 2d o-connect.' dbg-
2dc0: 64 69 73 63 6f 6e 6e 65 63 74 20 49 53 20 64 6f disconnect IS do
2dd0: 2d 64 69 73 63 6f 6e 6e 65 63 74 0a 0a 5c 5c 5c -disconnect..\\\
2de0: 0a 4c 6f 63 61 6c 20 56 61 72 69 61 62 6c 65 73 .Local Variables
2df0: 3a 0a 66 6f 72 74 68 2d 6c 6f 63 61 6c 2d 77 6f :.forth-local-wo
2e00: 72 64 73 3a 0a 20 20 20 20 28 0a 20 20 20 20 20 rds:. (.
2e10: 28 28 22 6e 65 74 32 6f 3a 22 20 22 2b 6e 65 74 (("net2o:" "+net
2e20: 32 6f 3a 22 29 20 64 65 66 69 6e 69 74 69 6f 6e 2o:") definition
2e30: 2d 73 74 61 72 74 65 72 20 28 66 6f 6e 74 2d 6c -starter (font-l
2e40: 6f 63 6b 2d 6b 65 79 77 6f 72 64 2d 66 61 63 65 ock-keyword-face
2e50: 20 2e 20 31 29 0a 20 20 20 20 20 20 22 5b 20 5c . 1). "[ \
2e60: 74 5c 6e 5d 22 20 74 20 6e 61 6d 65 20 28 66 6f t\n]" t name (fo
2e70: 6e 74 2d 6c 6f 63 6b 2d 66 75 6e 63 74 69 6f 6e nt-lock-function
2e80: 2d 6e 61 6d 65 2d 66 61 63 65 20 2e 20 33 29 29 -name-face . 3))
2e90: 0a 20 20 20 20 20 28 22 5b 61 2d 7a 30 2d 39 5d . ("[a-z0-9]
2ea0: 2b 28 22 20 69 6d 6d 65 64 69 61 74 65 20 28 66 +(" immediate (f
2eb0: 6f 6e 74 2d 6c 6f 63 6b 2d 63 6f 6d 6d 65 6e 74 ont-lock-comment
2ec0: 2d 66 61 63 65 20 2e 20 31 29 0a 20 20 20 20 20 -face . 1).
2ed0: 20 22 29 22 20 6e 69 6c 20 63 6f 6d 6d 65 6e 74 ")" nil comment
2ee0: 20 28 66 6f 6e 74 2d 6c 6f 63 6b 2d 63 6f 6d 6d (font-lock-comm
2ef0: 65 6e 74 2d 66 61 63 65 20 2e 20 31 29 29 0a 20 ent-face . 1)).
2f00: 20 20 20 29 0a 66 6f 72 74 68 2d 6c 6f 63 61 6c ).forth-local
2f10: 2d 69 6e 64 65 6e 74 2d 77 6f 72 64 73 3a 0a 20 -indent-words:.
2f20: 20 20 20 28 0a 20 20 20 20 20 28 28 22 6e 65 74 (. (("net
2f30: 32 6f 3a 22 20 22 2b 6e 65 74 32 6f 3a 22 29 20 2o:" "+net2o:")
2f40: 28 30 20 2e 20 32 29 20 28 30 20 2e 20 32 29 20 (0 . 2) (0 . 2)
2f50: 6e 6f 6e 2d 69 6d 6d 65 64 69 61 74 65 29 0a 20 non-immediate).
2f60: 20 20 20 29 0a 45 6e 64 3a 0a 5b 54 48 45 4e 5d ).End:.[THEN]
2f70: 0a .