Artifact
4cd5eb62bb66f71750dafa8e43fe05ce0ce821d8
File
helper.fs
— part of check-in
[cfc7fe3d19]
at
2019-04-26 19:12:06
on branch trunk
— Fix for bugs Martin detected yesterday
(user:
bernd
size: 12109)
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 20 20 54 48 45 4e 20 3b 0a 3a ection THEN ;.:
0af0: 20 64 68 74 2d 64 69 73 63 6f 6e 6e 65 63 74 20 dht-disconnect
0b00: 28 20 2d 2d 20 29 0a 20 20 20 20 30 20 61 64 64 ( -- ). 0 add
0b10: 72 20 64 68 74 2d 63 6f 6e 6e 65 63 74 69 6f 6e r dht-connection
0b20: 20 21 40 20 20 3f 64 75 70 2d 49 46 0a 09 3e 6f !@ ?dup-IF..>o
0b30: 20 6f 20 74 6f 20 63 6f 6e 6e 65 63 74 69 6f 6e o to connection
0b40: 20 64 69 73 63 6f 6e 6e 65 63 74 2d 6d 65 20 6f disconnect-me o
0b50: 3e 20 20 54 48 45 4e 20 3b 0a 0a 56 61 72 69 61 > THEN ;..Varia
0b60: 62 6c 65 20 61 6e 6e 6f 75 6e 63 65 64 0a 3a 20 ble announced.:
0b70: 73 75 62 6d 65 20 28 20 2d 2d 20 29 20 20 61 6e subme ( -- ) an
0b80: 6e 6f 75 6e 63 65 64 20 40 20 49 46 0a 09 64 68 nounced @ IF..dh
0b90: 74 2d 63 6f 6e 6e 65 63 74 20 73 75 62 2d 6d 65 t-connect sub-me
0ba0: 20 54 48 45 4e 20 3b 0a 0a 3a 20 63 3a 64 69 73 THEN ;..: c:dis
0bb0: 63 6f 6e 6e 65 63 74 20 28 20 2d 2d 20 29 20 63 connect ( -- ) c
0bc0: 6f 6e 6e 65 63 74 28 20 5b 3a 20 2e 22 20 44 69 onnect( [: ." Di
0bd0: 73 63 6f 6e 6e 65 63 74 69 6e 67 2e 2e 2e 22 20 sconnecting..."
0be0: 63 72 20 3b 5d 20 24 65 72 72 20 29 0a 20 20 20 cr ;] $err ).
0bf0: 20 64 69 73 63 6f 6e 6e 65 63 74 2d 6d 65 20 63 disconnect-me c
0c00: 6f 6e 6e 65 63 74 28 20 5b 3a 20 2e 70 61 63 6b onnect( [: .pack
0c10: 65 74 73 20 70 72 6f 66 69 6c 65 28 20 2e 74 69 ets profile( .ti
0c20: 6d 65 73 20 29 20 3b 5d 20 24 65 72 72 20 29 20 mes ) ;] $err )
0c30: 3b 0a 0a 3a 20 63 3a 66 65 74 63 68 2d 69 64 20 ;..: c:fetch-id
0c40: 28 20 70 75 62 6b 65 79 20 75 20 2d 2d 20 29 0a ( pubkey u -- ).
0c50: 20 20 20 20 6e 65 74 32 6f 2d 63 6f 64 65 0a 20 net2o-code.
0c60: 20 20 20 20 20 65 78 70 65 63 74 2d 72 65 70 6c expect-repl
0c70: 79 20 20 66 65 74 63 68 2d 69 64 2c 0a 20 20 20 y fetch-id,.
0c80: 20 20 20 63 6f 6f 6b 69 65 2b 72 65 71 75 65 73 cookie+reques
0c90: 74 0a 20 20 20 20 65 6e 64 2d 63 6f 64 65 7c 20 t. end-code|
0ca0: 3b 0a 0a 3a 20 70 6b 3a 66 65 74 63 68 2d 68 6f ;..: pk:fetch-ho
0cb0: 73 74 20 28 20 6b 65 79 20 75 20 2d 2d 20 29 0a st ( key u -- ).
0cc0: 20 20 20 20 6e 65 74 32 6f 2d 63 6f 64 65 0a 20 net2o-code.
0cd0: 20 20 20 20 20 65 78 70 65 63 74 2d 72 65 70 6c expect-repl
0ce0: 79 20 67 65 74 2d 69 70 20 66 65 74 63 68 2d 69 y get-ip fetch-i
0cf0: 64 2c 20 63 6f 6f 6b 69 65 2b 72 65 71 75 65 73 d, cookie+reques
0d00: 74 0a 20 20 20 20 65 6e 64 2d 63 6f 64 65 7c 20 t. end-code|
0d10: 2d 73 65 74 69 70 20 3b 0a 0a 3a 20 70 6b 3a 61 -setip ;..: pk:a
0d20: 64 64 6d 65 2d 66 65 74 63 68 2d 68 6f 73 74 20 ddme-fetch-host
0d30: 28 20 6b 65 79 20 75 20 2d 2d 20 29 20 2b 61 64 ( key u -- ) +ad
0d40: 64 6d 65 0a 20 20 20 20 6e 65 74 32 6f 2d 63 6f dme. net2o-co
0d50: 64 65 0a 20 20 20 20 20 20 65 78 70 65 63 74 2d de. expect-
0d60: 72 65 70 6c 79 20 67 65 74 2d 69 70 20 66 65 74 reply get-ip fet
0d70: 63 68 2d 69 64 2c 20 72 65 70 6c 61 63 65 2d 6d ch-id, replace-m
0d80: 65 2c 0a 20 20 20 20 20 20 63 6f 6f 6b 69 65 2b e,. cookie+
0d90: 72 65 71 75 65 73 74 0a 20 20 20 20 65 6e 64 2d request. end-
0da0: 63 6f 64 65 7c 20 2d 73 65 74 69 70 20 6e 65 74 code| -setip net
0db0: 32 6f 3a 73 65 6e 64 2d 72 65 70 6c 61 63 65 20 2o:send-replace
0dc0: 20 61 6e 6e 6f 75 6e 63 65 64 20 6f 6e 20 3b 0a announced on ;.
0dd0: 0a 5c 20 4e 41 54 20 72 65 74 72 61 76 65 72 73 .\ NAT retravers
0de0: 61 6c 0a 0a 46 6f 72 77 61 72 64 20 69 6e 73 65 al..Forward inse
0df0: 72 74 2d 61 64 64 72 20 28 20 6f 20 2d 2d 20 29 rt-addr ( o -- )
0e00: 0a 0a 3a 20 72 65 6e 61 74 20 28 20 2d 2d 20 29 ..: renat ( -- )
0e10: 0a 20 20 20 20 6d 73 67 2d 67 72 6f 75 70 73 20 . msg-groups
0e20: 5b 3a 0a 20 20 20 20 20 20 63 65 6c 6c 2b 20 24 [:. cell+ $
0e30: 40 20 62 6f 75 6e 64 73 20 3f 44 4f 0a 09 20 20 @ bounds ?DO..
0e40: 49 20 40 20 3e 6f 20 6f 2d 62 65 61 63 6f 6e 20 I @ >o o-beacon
0e50: 70 69 6e 67 73 0a 09 20 20 5c 20 21 21 46 49 58 pings.. \ !!FIX
0e60: 4d 45 21 21 20 73 68 6f 75 6c 64 20 6d 61 79 62 ME!! should mayb
0e70: 65 20 64 6f 20 61 20 72 65 2d 6c 6f 6f 6b 75 70 e do a re-lookup
0e80: 3f 0a 09 20 20 72 65 74 2d 61 64 64 72 20 24 31 ?.. ret-addr $1
0e90: 30 20 65 72 61 73 65 20 20 64 65 73 74 2d 30 6b 0 erase dest-0k
0ea0: 65 79 20 64 65 73 74 2d 30 6b 65 79 3e 20 21 0a ey dest-0key> !.
0eb0: 09 20 20 70 75 6e 63 68 2d 61 64 64 72 73 20 24 . punch-addrs $
0ec0: 40 20 62 6f 75 6e 64 73 20 3f 44 4f 0a 09 20 20 @ bounds ?DO..
0ed0: 20 20 20 20 49 20 40 20 69 6e 73 65 72 74 2d 61 I @ insert-a
0ee0: 64 64 72 20 49 46 0a 09 09 20 20 6f 20 74 6f 20 ddr IF... o to
0ef0: 63 6f 6e 6e 65 63 74 69 6f 6e 0a 09 09 20 20 6e connection... n
0f00: 65 74 32 6f 2d 63 6f 64 65 20 6e 65 77 2d 72 65 et2o-code new-re
0f10: 71 75 65 73 74 20 74 72 75 65 20 67 65 6e 2d 70 quest true gen-p
0f20: 75 6e 63 68 6c 6f 61 64 20 67 65 6e 2d 70 75 6e unchload gen-pun
0f30: 63 68 0a 09 09 20 20 65 6e 64 2d 63 6f 64 65 0a ch... end-code.
0f40: 09 20 20 20 20 20 20 54 48 45 4e 0a 09 20 20 63 . THEN.. c
0f50: 65 6c 6c 20 2b 4c 4f 4f 50 20 6f 3e 0a 20 20 20 ell +LOOP o>.
0f60: 20 20 20 63 65 6c 6c 20 2b 4c 4f 4f 50 0a 20 20 cell +LOOP.
0f70: 20 20 3b 5d 20 23 6d 61 70 20 3b 0a 0a 5c 20 6e ;] #map ;..\ n
0f80: 6f 74 69 66 69 63 61 74 69 6f 6e 20 66 6f 72 20 otification for
0f90: 61 64 64 72 65 73 73 20 63 68 61 6e 67 65 73 0a address changes.
0fa0: 0a 5b 49 46 44 45 46 5d 20 61 6e 64 72 6f 69 64 .[IFDEF] android
0fb0: 20 20 20 20 20 72 65 71 75 69 72 65 20 61 6e 64 require and
0fc0: 72 6f 69 64 2f 6e 65 74 2e 66 73 20 20 5b 45 4c roid/net.fs [EL
0fd0: 53 45 5d 0a 20 20 20 20 5b 49 46 44 45 46 5d 20 SE]. [IFDEF]
0fe0: 50 46 5f 4e 45 54 4c 49 4e 4b 20 20 72 65 71 75 PF_NETLINK requ
0ff0: 69 72 65 20 6c 69 6e 75 78 2f 6e 65 74 2e 66 73 ire linux/net.fs
1000: 20 20 20 20 5b 54 48 45 4e 5d 0a 5b 54 48 45 4e [THEN].[THEN
1010: 5d 0a 0a 5c 20 61 6e 6e 6f 75 6e 63 65 20 61 6e ]..\ announce an
1020: 64 20 72 65 6e 61 74 0a 0a 3a 20 61 6e 6e 6f 75 d renat..: annou
1030: 6e 63 65 2d 6d 65 20 28 20 2d 2d 20 29 0a 20 20 nce-me ( -- ).
1040: 20 20 5c 20 43 68 65 63 6b 20 66 6f 72 20 64 69 \ Check for di
1050: 73 63 6f 6e 6e 65 63 74 65 64 20 73 74 61 74 65 sconnected state
1060: 0a 20 20 20 20 64 68 74 2d 63 6f 6e 6e 65 63 74 . dht-connect
1070: 20 6f 6e 6c 69 6e 65 3f 20 49 46 20 20 72 65 70 online? IF rep
1080: 6c 61 63 65 2d 6d 65 20 2d 6f 74 68 65 72 20 20 lace-me -other
1090: 61 6e 6e 6f 75 6e 63 65 64 20 6f 6e 20 20 54 48 announced on TH
10a0: 45 4e 20 3b 0a 0a 3a 20 72 65 6e 61 74 2d 61 6c EN ;..: renat-al
10b0: 6c 20 28 20 2d 2d 20 29 20 62 65 61 63 6f 6e 28 l ( -- ) beacon(
10c0: 20 2e 22 20 72 65 6d 6f 76 65 20 61 6c 6c 20 62 ." remove all b
10d0: 65 61 63 6f 6e 73 22 20 63 72 20 29 0a 20 20 20 eacons" cr ).
10e0: 20 5b 49 46 44 45 46 5d 20 72 65 6e 61 74 2d 63 [IFDEF] renat-c
10f0: 6f 6d 70 6c 65 74 65 20 5b 3a 20 5b 54 48 45 4e omplete [: [THEN
1100: 5d 0a 09 30 20 2e 21 6d 79 2d 61 64 64 72 20 64 ]..0 .!my-addr d
1110: 68 74 2d 64 69 73 63 6f 6e 6e 65 63 74 20 5c 20 ht-disconnect \
1120: 6f 6c 64 20 44 48 54 20 6d 61 79 20 62 65 20 73 old DHT may be s
1130: 74 61 6c 65 0a 09 61 6e 6e 6f 75 6e 63 65 2d 6d tale..announce-m
1140: 65 20 5c 20 69 66 20 77 65 20 73 75 63 63 65 65 e \ if we succee
1150: 64 20 68 65 72 65 2c 20 77 65 20 63 61 6e 20 74 d here, we can t
1160: 72 79 20 74 68 65 20 72 65 73 74 0a 09 62 65 61 ry the rest..bea
1170: 63 6f 6e 73 23 20 23 66 72 65 65 73 0a 09 30 20 cons# #frees..0
1180: 3e 6f 20 64 68 74 72 6f 6f 74 20 2b 64 68 74 2d >o dhtroot +dht-
1190: 62 65 61 63 6f 6e 20 6f 3e 0a 09 72 65 6e 61 74 beacon o>..renat
11a0: 0a 20 20 20 20 5b 49 46 44 45 46 5d 20 72 65 6e . [IFDEF] ren
11b0: 61 74 2d 63 6f 6d 70 6c 65 74 65 20 3b 5d 20 63 at-complete ;] c
11c0: 61 74 63 68 20 72 65 6e 61 74 2d 63 6f 6d 70 6c atch renat-compl
11d0: 65 74 65 20 74 68 72 6f 77 20 5b 54 48 45 4e 5d ete throw [THEN]
11e0: 0a 20 20 20 20 62 65 61 63 6f 6e 28 20 2e 22 20 . beacon( ."
11f0: 64 6f 6e 65 20 72 65 6e 61 74 22 20 63 72 20 29 done renat" cr )
1200: 20 3b 0a 0a 73 63 6f 70 65 7b 20 2f 63 68 61 74 ;..scope{ /chat
1210: 0a 3a 20 2f 72 65 6e 61 74 20 28 20 61 64 64 72 .: /renat ( addr
1220: 20 75 20 2d 2d 20 29 20 72 65 6e 61 74 2d 61 6c u -- ) renat-al
1230: 6c 20 2f 6e 61 74 20 3b 0a 7d 73 63 6f 70 65 0a l /nat ;.}scope.
1240: 0a 5c 20 62 65 61 63 6f 6e 20 68 61 6e 64 6c 69 .\ beacon handli
1250: 6e 67 0a 0a 65 76 65 6e 74 3a 20 3a 3e 64 6f 2d ng..event: :>do-
1260: 62 65 61 63 6f 6e 20 28 20 61 64 64 72 20 2d 2d beacon ( addr --
1270: 20 29 0a 20 20 20 20 62 65 61 63 6f 6e 28 20 2e ). beacon( .
1280: 22 20 3a 3e 64 6f 2d 62 65 61 63 6f 6e 22 20 66 " :>do-beacon" f
1290: 6f 72 74 68 3a 63 72 20 29 0a 20 20 20 20 7b 20 orth:cr ). {
12a0: 62 65 61 63 6f 6e 20 7d 20 62 65 61 63 6f 6e 20 beacon } beacon
12b0: 63 65 6c 6c 2b 20 24 40 20 31 20 36 34 73 20 2f cell+ $@ 1 64s /
12c0: 73 74 72 69 6e 67 20 62 6f 75 6e 64 73 20 3f 44 string bounds ?D
12d0: 4f 0a 09 62 65 61 63 6f 6e 20 24 40 20 49 20 32 O..beacon $@ I 2
12e0: 40 20 2e 65 78 65 63 75 74 65 0a 20 20 20 20 32 @ .execute. 2
12f0: 20 63 65 6c 6c 73 20 2b 4c 4f 4f 50 20 3b 0a 0a cells +LOOP ;..
1300: 3a 20 64 6f 2d 62 65 61 63 6f 6e 20 28 20 61 64 : do-beacon ( ad
1310: 64 72 20 2d 2d 20 29 20 20 5c 20 73 69 67 6e 20 dr -- ) \ sign
1320: 6f 6e 2c 20 61 6e 64 20 64 6f 20 61 20 72 65 70 on, and do a rep
1330: 6c 61 63 65 2d 6d 65 0a 20 20 20 20 3c 65 76 65 lace-me. <eve
1340: 6e 74 20 65 6c 69 74 2c 20 3a 3e 64 6f 2d 62 65 nt elit, :>do-be
1350: 61 63 6f 6e 20 3f 71 75 65 72 79 2d 74 61 73 6b acon ?query-task
1360: 20 65 76 65 6e 74 3e 20 3b 0a 0a 0a 56 61 72 69 event> ;...Vari
1370: 61 62 6c 65 20 6d 79 2d 62 65 61 63 6f 6e 0a 0a able my-beacon..
1380: 3a 20 6d 79 2d 62 65 61 63 6f 6e 2d 68 61 73 68 : my-beacon-hash
1390: 20 28 20 2d 2d 20 68 61 73 68 20 75 20 29 0a 20 ( -- hash u ).
13a0: 20 20 20 6d 79 2d 62 65 61 63 6f 6e 20 24 40 20 my-beacon $@
13b0: 64 75 70 20 3f 45 58 49 54 20 20 32 64 72 6f 70 dup ?EXIT 2drop
13c0: 0a 20 20 20 20 6d 79 2d 30 6b 65 79 20 73 65 63 . my-0key sec
13d0: 40 20 22 62 65 61 63 6f 6e 22 20 6b 65 79 65 64 @ "beacon" keyed
13e0: 2d 68 61 73 68 23 31 32 38 20 32 2f 20 6d 79 2d -hash#128 2/ my-
13f0: 62 65 61 63 6f 6e 20 24 21 0a 20 20 20 20 6d 79 beacon $!. my
1400: 2d 62 65 61 63 6f 6e 20 24 40 20 3b 0a 0a 3a 20 -beacon $@ ;..:
1410: 63 68 65 63 6b 2d 62 65 61 63 6f 6e 2d 68 61 73 check-beacon-has
1420: 68 20 28 20 61 64 64 72 20 75 20 2d 2d 20 66 6c h ( addr u -- fl
1430: 61 67 20 29 0a 20 20 20 20 6d 79 2d 62 65 61 63 ag ). my-beac
1440: 6f 6e 2d 68 61 73 68 20 73 74 72 3d 20 3b 0a 0a on-hash str= ;..
1450: 3a 20 63 68 65 63 6b 2d 70 75 6e 63 68 2d 68 61 : check-punch-ha
1460: 73 68 20 28 20 61 64 64 72 20 75 20 2d 2d 20 63 sh ( addr u -- c
1470: 6f 6e 6e 65 63 74 69 6f 6e 2f 66 61 6c 73 65 20 onnection/false
1480: 29 0a 5c 20 20 20 20 32 64 75 70 20 64 75 6d 70 ).\ 2dup dump
1490: 0a 20 20 20 20 64 75 70 20 24 31 38 20 3c 20 49 . dup $18 < I
14a0: 46 20 20 32 64 72 6f 70 20 66 61 6c 73 65 20 20 F 2drop false
14b0: 45 58 49 54 20 20 54 48 45 4e 0a 20 20 20 20 6f EXIT THEN. o
14c0: 76 65 72 20 6c 65 2d 36 34 40 20 3e 64 65 73 74 ver le-64@ >dest
14d0: 2d 6d 61 70 20 40 20 64 75 70 20 49 46 20 20 2e -map @ dup IF .
14e0: 70 61 72 65 6e 74 20 3e 6f 0a 09 38 20 2f 73 74 parent >o..8 /st
14f0: 72 69 6e 67 20 70 75 6e 63 68 23 20 6f 76 65 72 ring punch# over
1500: 20 6b 65 79 7c 20 73 74 72 3d 20 6f 20 61 6e 64 key| str= o and
1510: 20 6f 3e 0a 20 20 20 20 45 4c 53 45 20 20 6e 69 o>. ELSE ni
1520: 70 20 6e 69 70 20 20 54 48 45 4e 20 3b 0a 0a 0a p nip THEN ;...
1530: 3a 20 3f 2d 62 65 61 63 6f 6e 20 28 20 61 64 64 : ?-beacon ( add
1540: 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 5c 47 20 r u -- ). \G
1550: 69 66 20 77 65 20 64 6f 6e 27 74 20 6b 6e 6f 77 if we don't know
1560: 20 74 68 61 74 20 61 64 64 72 65 73 73 2c 20 73 that address, s
1570: 65 6e 64 20 61 20 72 65 70 6c 79 0a 20 20 20 20 end a reply.
1580: 6e 65 65 64 2d 62 65 61 63 6f 6e 23 20 40 20 49 need-beacon# @ I
1590: 46 0a 09 32 64 75 70 20 63 68 65 63 6b 2d 62 65 F..2dup check-be
15a0: 61 63 6f 6e 2d 68 61 73 68 20 30 3d 20 49 46 0a acon-hash 0= IF.
15b0: 09 20 20 20 20 62 65 61 63 6f 6e 28 20 74 69 63 . beacon( tic
15c0: 6b 73 20 2e 74 69 63 6b 73 20 2e 22 20 20 77 72 ks .ticks ." wr
15d0: 6f 6e 67 20 62 65 61 63 6f 6e 20 68 61 73 68 22 ong beacon hash"
15e0: 0a 09 20 20 20 20 38 35 74 79 70 65 20 2e 22 20 .. 85type ."
15f0: 20 69 6e 73 74 65 61 64 20 6f 66 20 22 20 6d 79 instead of " my
1600: 2d 62 65 61 63 6f 6e 20 24 40 20 38 35 74 79 70 -beacon $@ 85typ
1610: 65 20 63 72 20 29 65 6c 73 65 28 20 32 64 72 6f e cr )else( 2dro
1620: 70 20 29 20 20 45 58 49 54 0a 09 54 48 45 4e 0a p ) EXIT..THEN.
1630: 20 20 20 20 54 48 45 4e 20 20 32 64 72 6f 70 0a THEN 2drop.
1640: 20 20 20 20 6e 65 74 32 6f 2d 73 6f 63 6b 0a 20 net2o-sock.
1650: 20 20 20 73 6f 63 6b 61 64 64 72 3c 20 61 6c 65 sockaddr< ale
1660: 6e 20 40 20 72 6f 75 74 65 73 23 20 23 40 20 6e n @ routes# #@ n
1670: 69 70 20 30 3d 20 49 46 20 20 22 21 22 20 20 45 ip 0= IF "!" E
1680: 4c 53 45 20 20 22 2e 22 20 20 54 48 45 4e 0a 20 LSE "." THEN.
1690: 20 20 20 62 65 61 63 6f 6e 28 20 74 69 63 6b 73 beacon( ticks
16a0: 20 2e 74 69 63 6b 73 20 2e 22 20 20 53 65 6e 64 .ticks ." Send
16b0: 20 27 22 20 32 64 75 70 20 32 64 75 70 20 70 72 '" 2dup 2dup pr
16c0: 69 6e 74 61 62 6c 65 3f 20 49 46 20 20 74 79 70 intable? IF typ
16d0: 65 20 20 45 4c 53 45 20 20 38 35 74 79 70 65 20 e ELSE 85type
16e0: 20 54 48 45 4e 0a 20 20 20 20 2e 22 20 27 20 72 THEN. ." ' r
16f0: 65 70 6c 79 20 74 6f 3a 20 22 20 73 6f 63 6b 61 eply to: " socka
1700: 64 64 72 3c 20 61 6c 65 6e 20 40 20 2e 61 64 64 ddr< alen @ .add
1710: 72 65 73 73 20 66 6f 72 74 68 3a 63 72 20 29 0a ress forth:cr ).
1720: 20 20 20 20 30 20 73 6f 63 6b 61 64 64 72 3c 20 0 sockaddr<
1730: 61 6c 65 6e 20 40 20 73 65 6e 64 74 6f 20 64 72 alen @ sendto dr
1740: 6f 70 20 2b 73 65 6e 64 20 3b 0a 3a 20 21 2d 62 op +send ;.: !-b
1750: 65 61 63 6f 6e 20 28 20 61 64 64 72 20 75 20 2d eacon ( addr u -
1760: 2d 20 29 20 32 64 72 6f 70 0a 20 20 20 20 5c 47 - ) 2drop. \G
1770: 20 49 20 67 6f 74 20 61 20 72 65 70 6c 79 2c 20 I got a reply,
1780: 6d 79 20 61 64 64 72 65 73 73 20 69 73 20 75 6e my address is un
1790: 6b 6e 6f 77 6e 0a 20 20 20 20 62 65 61 63 6f 6e known. beacon
17a0: 28 20 74 69 63 6b 73 20 2e 74 69 63 6b 73 20 2e ( ticks .ticks .
17b0: 22 20 20 47 6f 74 20 75 6e 6b 6e 6f 77 6e 20 72 " Got unknown r
17c0: 65 70 6c 79 3a 20 22 20 73 6f 63 6b 61 64 64 72 eply: " sockaddr
17d0: 3c 20 61 6c 65 6e 20 40 20 2e 61 64 64 72 65 73 < alen @ .addres
17e0: 73 20 66 6f 72 74 68 3a 63 72 20 29 0a 20 20 20 s forth:cr ).
17f0: 20 73 6f 63 6b 61 64 64 72 3c 20 61 6c 65 6e 20 sockaddr< alen
1800: 40 20 62 65 61 63 6f 6e 73 23 20 23 40 20 64 30 @ beacons# #@ d0
1810: 3c 3e 20 49 46 20 20 6c 61 73 74 23 20 64 6f 2d <> IF last# do-
1820: 62 65 61 63 6f 6e 20 20 54 48 45 4e 20 3b 0a 3a beacon THEN ;.:
1830: 20 2e 2d 62 65 61 63 6f 6e 20 28 20 61 64 64 72 .-beacon ( addr
1840: 20 75 20 2d 2d 20 29 20 32 64 72 6f 70 0a 20 20 u -- ) 2drop.
1850: 20 20 5c 47 20 49 20 67 6f 74 20 61 20 72 65 70 \G I got a rep
1860: 6c 79 2c 20 6d 79 20 61 64 64 72 65 73 73 20 69 ly, my address i
1870: 73 20 6b 6e 6f 77 6e 0a 20 20 20 20 62 65 61 63 s known. beac
1880: 6f 6e 28 20 74 69 63 6b 73 20 2e 74 69 63 6b 73 on( ticks .ticks
1890: 20 2e 22 20 20 47 6f 74 20 6b 6e 6f 77 6e 20 72 ." Got known r
18a0: 65 70 6c 79 3a 20 22 20 73 6f 63 6b 61 64 64 72 eply: " sockaddr
18b0: 3c 20 61 6c 65 6e 20 40 20 2e 61 64 64 72 65 73 < alen @ .addres
18c0: 73 20 66 6f 72 74 68 3a 63 72 20 29 0a 20 20 20 s forth:cr ).
18d0: 20 73 6f 63 6b 61 64 64 72 3c 20 61 6c 65 6e 20 sockaddr< alen
18e0: 40 20 62 65 61 63 6f 6e 73 23 20 23 40 20 49 46 @ beacons# #@ IF
18f0: 0a 09 3e 72 20 72 40 20 36 34 40 20 74 69 63 6b ..>r r@ 64@ tick
1900: 73 20 36 34 75 6d 69 6e 20 62 65 61 63 6f 6e 2d s 64umin beacon-
1910: 74 69 63 6b 73 23 20 36 34 2b 20 72 3e 20 36 34 ticks# 64+ r> 64
1920: 21 0a 20 20 20 20 45 4c 53 45 20 20 64 72 6f 70 !. ELSE drop
1930: 20 20 54 48 45 4e 20 3b 0a 3a 20 3e 2d 62 65 61 THEN ;.: >-bea
1940: 63 6f 6e 20 28 20 61 64 64 72 20 75 20 2d 2d 20 con ( addr u --
1950: 29 0a 20 20 20 20 5c 47 20 49 20 67 6f 74 20 61 ). \G I got a
1960: 20 70 75 6e 63 68 0a 20 20 20 20 6e 61 74 28 20 punch. nat(
1970: 74 69 63 6b 73 20 2e 74 69 63 6b 73 20 2e 22 20 ticks .ticks ."
1980: 20 47 6f 74 20 70 75 6e 63 68 3a 20 22 20 73 6f Got punch: " so
1990: 63 6b 61 64 64 72 3c 20 61 6c 65 6e 20 40 20 2e ckaddr< alen @ .
19a0: 61 64 64 72 65 73 73 20 66 6f 72 74 68 3a 63 72 address forth:cr
19b0: 20 29 0a 20 20 20 20 63 68 65 63 6b 2d 70 75 6e ). check-pun
19c0: 63 68 2d 68 61 73 68 20 3f 64 75 70 2d 49 46 0a ch-hash ?dup-IF.
19d0: 09 5c 20 21 21 46 49 58 4d 45 21 21 20 61 63 63 .\ !!FIXME!! acc
19e0: 65 70 74 20 6f 6e 6c 79 20 74 77 6f 3a 20 6f 6e ept only two: on
19f0: 65 20 49 50 76 34 2c 20 6f 6e 65 20 49 50 76 36 e IPv4, one IPv6
1a00: 2e 0a 09 5c 20 21 21 46 49 58 4d 45 21 21 20 61 ...\ !!FIXME!! a
1a10: 6e 64 20 74 72 79 20 6d 65 72 67 69 6e 67 20 74 nd try merging t
1a20: 68 65 20 74 77 6f 20 69 6e 74 6f 20 65 78 69 73 he two into exis
1a30: 74 65 6e 74 0a 09 3e 6f 20 73 6f 63 6b 61 64 64 tent..>o sockadd
1a40: 72 3c 20 61 6c 65 6e 20 40 20 6e 61 74 28 20 2e r< alen @ nat( .
1a50: 22 20 2b 70 75 6e 63 68 20 22 20 32 64 75 70 20 " +punch " 2dup
1a60: 2e 61 64 64 72 65 73 73 20 66 6f 72 74 68 3a 63 .address forth:c
1a70: 72 20 29 0a 09 2e 73 6f 63 6b 61 64 64 72 20 6e r )...sockaddr n
1a80: 65 77 2d 61 64 64 72 20 70 75 6e 63 68 2d 61 64 ew-addr punch-ad
1a90: 64 72 73 20 3e 73 74 61 63 6b 20 6f 3e 0a 20 20 drs >stack o>.
1aa0: 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 68 61 6e 64 THEN ;..: hand
1ab0: 6c 65 2d 62 65 61 63 6f 6e 20 28 20 61 64 64 72 le-beacon ( addr
1ac0: 20 75 20 63 68 61 72 20 2d 2d 20 29 0a 20 20 20 u char -- ).
1ad0: 20 63 61 73 65 0a 09 27 3f 27 20 6f 66 20 20 3f case..'?' of ?
1ae0: 2d 62 65 61 63 6f 6e 20 20 65 6e 64 6f 66 0a 09 -beacon endof..
1af0: 27 21 27 20 6f 66 20 20 21 2d 62 65 61 63 6f 6e '!' of !-beacon
1b00: 20 20 65 6e 64 6f 66 0a 09 27 2e 27 20 6f 66 20 endof..'.' of
1b10: 20 2e 2d 62 65 61 63 6f 6e 20 20 65 6e 64 6f 66 .-beacon endof
1b20: 0a 09 27 3e 27 20 6f 66 20 20 3e 2d 62 65 61 63 ..'>' of >-beac
1b30: 6f 6e 20 20 65 6e 64 6f 66 0a 09 6e 69 70 0a 20 on endof..nip.
1b40: 20 20 20 65 6e 64 63 61 73 65 20 3b 0a 0a 3a 20 endcase ;..:
1b50: 68 61 6e 64 6c 65 2d 62 65 61 63 6f 6e 2b 68 61 handle-beacon+ha
1b60: 73 68 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 sh ( addr u -- )
1b70: 0a 20 20 20 20 64 75 70 20 49 46 20 20 6f 76 65 . dup IF ove
1b80: 72 20 63 40 20 3e 72 20 31 20 2f 73 74 72 69 6e r c@ >r 1 /strin
1b90: 67 20 72 3e 20 68 61 6e 64 6c 65 2d 62 65 61 63 g r> handle-beac
1ba0: 6f 6e 20 20 45 4c 53 45 20 20 32 64 72 6f 70 20 on ELSE 2drop
1bb0: 20 54 48 45 4e 20 3b 0a 0a 3a 20 72 65 70 6c 61 THEN ;..: repla
1bc0: 63 65 2d 6c 6f 6f 70 20 28 20 61 64 64 72 20 75 ce-loop ( addr u
1bd0: 20 2d 2d 20 66 6c 61 67 20 29 0a 20 20 20 20 42 -- flag ). B
1be0: 45 47 49 4e 20 20 6b 65 79 32 7c 20 3e 64 23 69 EGIN key2| >d#i
1bf0: 64 20 3e 6f 20 64 68 74 2d 68 6f 73 74 20 24 5b d >o dht-host $[
1c00: 5d 23 20 49 46 20 20 30 20 64 68 74 2d 68 6f 73 ]# IF 0 dht-hos
1c10: 74 20 24 5b 5d 40 20 20 45 4c 53 45 20 20 23 30 t $[]@ ELSE #0
1c20: 2e 20 20 54 48 45 4e 20 6f 3e 0a 09 32 64 75 70 . THEN o>..2dup
1c30: 20 64 30 3c 3e 20 57 48 49 4c 45 0a 09 20 20 20 d0<> WHILE..
1c40: 20 6f 76 65 72 20 63 40 20 27 21 27 20 3d 20 57 over c@ '!' = W
1c50: 48 49 4c 45 0a 09 09 72 65 70 6c 61 63 65 2d 6b HILE...replace-k
1c60: 65 79 20 6f 3e 0a 09 09 63 6f 6e 6e 65 63 74 28 ey o>...connect(
1c70: 20 3e 6f 20 6b 65 2d 70 6b 20 24 40 20 2e 22 20 >o ke-pk $@ ."
1c80: 72 65 70 6c 61 63 65 20 6b 65 79 3a 20 22 20 32 replace key: " 2
1c90: 64 75 70 20 38 35 74 79 70 65 20 63 72 20 6f 20 dup 85type cr o
1ca0: 6f 3e 20 29 0a 09 09 3e 72 20 32 64 75 70 20 63 o> )...>r 2dup c
1cb0: 3a 66 65 74 63 68 2d 69 64 20 72 3e 20 3e 6f 20 :fetch-id r> >o
1cc0: 20 52 45 50 45 41 54 20 20 54 48 45 4e 20 20 64 REPEAT THEN d
1cd0: 30 3c 3e 20 3b 0a 0a 3a 20 70 6b 2d 71 75 65 72 0<> ;..: pk-quer
1ce0: 79 20 28 20 61 64 64 72 20 75 20 78 74 20 2d 2d y ( addr u xt --
1cf0: 20 66 6c 61 67 20 29 20 3e 72 0a 20 20 20 20 64 flag ) >r. d
1d00: 68 74 2d 63 6f 6e 6e 65 63 74 20 6f 6e 6c 69 6e ht-connect onlin
1d10: 65 3f 20 49 46 20 20 32 64 75 70 20 72 3e 20 65 e? IF 2dup r> e
1d20: 78 65 63 75 74 65 20 20 72 65 70 6c 61 63 65 2d xecute replace-
1d30: 6c 6f 6f 70 0a 20 20 20 20 45 4c 53 45 20 20 32 loop. ELSE 2
1d40: 64 72 6f 70 20 72 64 72 6f 70 20 66 61 6c 73 65 drop rdrop false
1d50: 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 70 6b 2d 6c THEN ;..: pk-l
1d60: 6f 6f 6b 75 70 20 28 20 61 64 64 72 20 75 20 2d ookup ( addr u -
1d70: 2d 20 29 0a 20 20 20 20 5b 27 5d 20 70 6b 3a 66 - ). ['] pk:f
1d80: 65 74 63 68 2d 68 6f 73 74 20 20 5b 27 5d 20 70 etch-host ['] p
1d90: 6b 3a 61 64 64 6d 65 2d 66 65 74 63 68 2d 68 6f k:addme-fetch-ho
1da0: 73 74 20 20 61 6e 6e 6f 75 6e 63 65 64 20 40 20 st announced @
1db0: 73 65 6c 65 63 74 0a 20 20 20 20 70 6b 2d 71 75 select. pk-qu
1dc0: 65 72 79 20 30 3d 20 21 21 68 6f 73 74 2d 6e 6f ery 0= !!host-no
1dd0: 74 66 6f 75 6e 64 21 21 20 3b 0a 0a 3a 20 70 6b tfound!! ;..: pk
1de0: 2d 70 65 65 6b 3f 20 28 20 70 6b 20 75 20 2d 2d -peek? ( pk u --
1df0: 20 66 6c 61 67 20 29 20 20 5b 27 5d 20 70 6b 3a flag ) ['] pk:
1e00: 66 65 74 63 68 2d 68 6f 73 74 20 70 6b 2d 71 75 fetch-host pk-qu
1e10: 65 72 79 20 3b 0a 0a 55 73 65 72 20 68 6f 73 74 ery ;..User host
1e20: 63 24 20 5c 20 63 68 65 63 6b 20 66 6f 72 20 74 c$ \ check for t
1e30: 68 69 73 20 68 6f 73 74 6e 61 6d 65 0a 0a 3a 20 his hostname..:
1e40: 63 68 65 63 6b 2d 68 6f 73 74 3f 20 28 20 6f 20 check-host? ( o
1e50: 61 64 64 72 20 75 20 2d 2d 20 6f 20 61 64 64 72 addr u -- o addr
1e60: 27 20 75 20 66 6c 61 67 20 29 0a 20 20 20 20 32 ' u flag ). 2
1e70: 20 70 69 63 6b 20 2e 68 6f 73 74 3e 24 20 3b 0a pick .host>$ ;.
1e80: 0a 30 20 56 61 6c 75 65 20 3f 6d 79 73 65 6c 66 .0 Value ?myself
1e90: 0a 0a 3a 20 6d 79 68 6f 73 74 3d 20 28 20 6f 20 ..: myhost= ( o
1ea0: 2d 2d 20 66 6c 61 67 20 29 0a 20 20 20 20 2e 68 -- flag ). .h
1eb0: 6f 73 74 3a 69 64 20 24 40 20 68 6f 73 74 24 20 ost:id $@ host$
1ec0: 24 40 20 73 74 72 3d 20 3f 6d 79 73 65 6c 66 20 $@ str= ?myself
1ed0: 61 6e 64 20 3b 0a 20 20 20 20 0a 3a 20 68 6f 73 and ;. .: hos
1ee0: 74 3d 20 28 20 6f 20 2d 2d 20 66 6c 61 67 20 29 t= ( o -- flag )
1ef0: 0a 20 20 20 20 3e 6f 20 68 6f 73 74 63 24 20 24 . >o hostc$ $
1f00: 40 20 64 75 70 20 49 46 20 20 68 6f 73 74 3a 69 @ dup IF host:i
1f10: 64 20 24 40 20 73 74 72 3d 20 20 45 4c 53 45 20 d $@ str= ELSE
1f20: 20 32 64 72 6f 70 20 74 72 75 65 20 20 54 48 45 2drop true THE
1f30: 4e 20 20 6f 3e 20 3b 0a 0a 3a 20 69 6e 73 65 72 N o> ;..: inser
1f40: 74 2d 61 64 64 72 20 28 20 6f 20 2d 2d 20 66 6c t-addr ( o -- fl
1f50: 61 67 20 29 0a 20 20 20 20 63 6f 6e 6e 65 63 74 ag ). connect
1f60: 28 20 2e 22 20 63 68 65 63 6b 20 61 64 64 72 3a ( ." check addr:
1f70: 20 22 20 64 75 70 20 2e 61 64 64 72 20 63 72 20 " dup .addr cr
1f80: 29 20 20 66 61 6c 73 65 20 73 77 61 70 0a 20 20 ) false swap.
1f90: 20 20 5b 3a 20 63 68 65 63 6b 2d 61 64 64 72 31 [: check-addr1
1fa0: 20 30 3d 20 49 46 20 20 32 64 72 6f 70 20 45 58 0= IF 2drop EX
1fb0: 49 54 20 20 54 48 45 4e 0a 20 20 20 20 20 20 69 IT THEN. i
1fc0: 6e 73 65 72 74 2d 61 64 64 72 65 73 73 20 74 65 nsert-address te
1fd0: 6d 70 2d 61 64 64 72 20 69 6e 73 2d 64 65 73 74 mp-addr ins-dest
1fe0: 0a 20 20 20 20 20 20 63 6f 6e 6e 65 63 74 28 20 . connect(
1ff0: 2e 22 20 69 6e 73 65 72 74 20 68 6f 73 74 3a 20 ." insert host:
2000: 22 20 74 65 6d 70 2d 61 64 64 72 20 2e 61 64 64 " temp-addr .add
2010: 72 2d 70 61 74 68 20 63 72 20 29 0a 20 20 20 20 r-path cr ).
2020: 20 20 72 65 74 2d 61 64 64 72 20 24 31 30 20 30 ret-addr $10 0
2030: 20 73 6b 69 70 20 6e 69 70 20 30 3d 20 49 46 0a skip nip 0= IF.
2040: 09 20 20 74 65 6d 70 2d 61 64 64 72 20 72 65 74 . temp-addr ret
2050: 2d 61 64 64 72 20 24 31 30 20 6d 6f 76 65 0a 20 -addr $10 move.
2060: 20 20 20 20 20 54 48 45 4e 20 20 21 30 6b 65 79 THEN !0key
2070: 20 20 64 72 6f 70 20 74 72 75 65 20 3b 5d 20 61 drop true ;] a
2080: 64 64 72 3e 73 6f 63 6b 20 3b 0a 0a 3a 20 69 6e ddr>sock ;..: in
2090: 73 65 72 74 2d 61 64 64 72 24 20 28 20 61 64 64 sert-addr$ ( add
20a0: 72 20 75 20 2d 2d 20 66 6c 61 67 20 29 20 20 64 r u -- flag ) d
20b0: 65 73 74 2d 30 6b 65 79 20 64 65 73 74 2d 30 6b est-0key dest-0k
20c0: 65 79 3e 20 21 0a 20 20 20 20 6e 65 77 2d 61 64 ey> !. new-ad
20d0: 64 72 20 64 75 70 20 69 6e 73 65 72 74 2d 61 64 dr dup insert-ad
20e0: 64 72 20 73 77 61 70 20 2e 6e 65 74 32 6f 3a 64 dr swap .net2o:d
20f0: 69 73 70 6f 73 65 2d 61 64 64 72 20 3b 0a 0a 3a ispose-addr ;..:
2100: 20 69 6e 73 65 72 74 2d 68 6f 73 74 20 28 20 61 insert-host ( a
2110: 64 64 72 20 75 20 2d 2d 20 66 6c 61 67 20 29 20 ddr u -- flag )
2120: 20 64 65 73 74 2d 30 6b 65 79 20 64 65 73 74 2d dest-0key dest-
2130: 30 6b 65 79 3e 20 21 0a 20 20 20 20 6e 65 77 2d 0key> !. new-
2140: 61 64 64 72 20 20 64 75 70 20 68 6f 73 74 3d 20 addr dup host=
2150: 20 6f 76 65 72 20 6d 79 68 6f 73 74 3d 20 30 3d over myhost= 0=
2160: 20 61 6e 64 20 20 49 46 0a 09 6d 73 67 28 20 2e and IF..msg( .
2170: 22 20 69 6e 73 65 72 74 3a 20 22 20 64 75 70 20 " insert: " dup
2180: 2e 68 6f 73 74 3a 69 64 20 24 40 20 74 79 70 65 .host:id $@ type
2190: 20 63 72 20 29 0a 09 64 75 70 20 69 6e 73 65 72 cr )..dup inser
21a0: 74 2d 61 64 64 72 20 20 45 4c 53 45 20 20 66 61 t-addr ELSE fa
21b0: 6c 73 65 20 20 54 48 45 4e 0a 20 20 20 20 73 77 lse THEN. sw
21c0: 61 70 20 2e 6e 65 74 32 6f 3a 64 69 73 70 6f 73 ap .net2o:dispos
21d0: 65 2d 61 64 64 72 20 3b 0a 0a 3a 20 69 6e 73 65 e-addr ;..: inse
21e0: 72 74 2d 68 6f 73 74 3f 20 28 20 66 6c 61 67 20 rt-host? ( flag
21f0: 6f 20 61 64 64 72 20 75 20 2d 2d 20 66 6c 61 67 o addr u -- flag
2200: 27 20 6f 20 29 0a 20 20 20 20 33 20 70 69 63 6b ' o ). 3 pick
2210: 20 49 46 20 20 32 64 72 6f 70 20 20 45 58 49 54 IF 2drop EXIT
2220: 20 20 54 48 45 4e 0a 20 20 20 20 63 68 65 63 6b THEN. check
2230: 2d 68 6f 73 74 3f 20 49 46 20 20 69 6e 73 65 72 -host? IF inser
2240: 74 2d 68 6f 73 74 20 20 45 4c 53 45 20 20 32 64 t-host ELSE 2d
2250: 72 6f 70 20 66 61 6c 73 65 20 20 54 48 45 4e 0a rop false THEN.
2260: 20 20 20 20 72 6f 74 20 6f 72 20 73 77 61 70 20 rot or swap
2270: 3b 0a 0a 3a 20 6d 61 6b 65 2d 63 6f 6e 74 65 78 ;..: make-contex
2280: 74 20 28 20 70 6b 20 75 20 2d 2d 20 29 0a 20 20 t ( pk u -- ).
2290: 20 20 72 65 74 30 20 6e 65 74 32 6f 3a 6e 65 77 ret0 net2o:new
22a0: 2d 63 6f 6e 74 65 78 74 20 3e 6f 20 72 64 72 6f -context >o rdro
22b0: 70 20 64 65 73 74 2d 70 6b 20 3b 0a 0a 69 6e 20 p dest-pk ;..in
22c0: 6e 65 74 32 6f 20 3a 20 70 6b 6c 6f 6f 6b 75 70 net2o : pklookup
22d0: 3f 20 28 20 70 6b 61 64 64 72 20 75 20 2d 2d 20 ? ( pkaddr u --
22e0: 66 6c 61 67 20 29 0a 20 20 20 20 32 64 75 70 20 flag ). 2dup
22f0: 6b 65 79 73 69 7a 65 32 20 73 61 66 65 2f 73 74 keysize2 safe/st
2300: 72 69 6e 67 20 68 6f 73 74 63 24 20 24 21 20 6b ring hostc$ $! k
2310: 65 79 32 7c 20 32 64 75 70 20 70 6b 63 20 6f 76 ey2| 2dup pkc ov
2320: 65 72 20 73 74 72 3d 20 74 6f 20 3f 6d 79 73 65 er str= to ?myse
2330: 6c 66 0a 20 20 20 20 32 64 75 70 20 3e 64 23 69 lf. 2dup >d#i
2340: 64 20 7b 20 69 64 20 7d 0a 20 20 20 20 69 64 20 d { id }. id
2350: 2e 64 68 74 2d 68 6f 73 74 20 24 5b 5d 23 20 30 .dht-host $[]# 0
2360: 3d 20 49 46 20 20 32 64 75 70 20 70 6b 2d 6c 6f = IF 2dup pk-lo
2370: 6f 6b 75 70 20 20 32 64 75 70 20 3e 64 23 69 64 okup 2dup >d#id
2380: 20 74 6f 20 69 64 20 20 54 48 45 4e 0a 20 20 20 to id THEN.
2390: 20 32 64 75 70 20 6d 61 6b 65 2d 63 6f 6e 74 65 2dup make-conte
23a0: 78 74 0a 20 20 20 20 66 61 6c 73 65 20 69 64 20 xt. false id
23b0: 64 75 70 20 2e 64 68 74 2d 68 6f 73 74 20 5b 27 dup .dht-host ['
23c0: 5d 20 69 6e 73 65 72 74 2d 68 6f 73 74 3f 20 24 ] insert-host? $
23d0: 5b 5d 6d 61 70 20 64 72 6f 70 0a 20 20 20 20 6e []map drop. n
23e0: 69 70 20 6e 69 70 20 3b 0a 69 6e 20 6e 65 74 32 ip nip ;.in net2
23f0: 6f 20 3a 20 70 6b 6c 6f 6f 6b 75 70 20 28 20 70 o : pklookup ( p
2400: 6b 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 kaddr u -- ).
2410: 20 6e 65 74 32 6f 3a 70 6b 6c 6f 6f 6b 75 70 3f net2o:pklookup?
2420: 20 30 3d 20 21 21 6e 6f 2d 61 64 64 72 65 73 73 0= !!no-address
2430: 21 21 20 3b 0a 0a 3a 20 3f 6e 61 74 2d 64 6f 6e !! ;..: ?nat-don
2440: 65 20 28 20 6e 20 2d 2d 20 29 0a 20 20 20 20 6e e ( n -- ). n
2450: 61 74 28 20 2e 22 20 72 65 71 20 64 6f 6e 65 2c at( ." req done,
2460: 20 69 73 73 75 65 20 6e 61 74 20 72 65 71 75 65 issue nat reque
2470: 73 74 22 20 66 6f 72 74 68 3a 63 72 20 29 0a 20 st" forth:cr ).
2480: 20 20 20 63 6f 6e 6e 65 63 74 2d 72 65 73 74 20 connect-rest
2490: 2b 66 6c 6f 77 2d 63 6f 6e 74 72 6f 6c 20 2b 72 +flow-control +r
24a0: 65 73 65 6e 64 20 3f 6e 61 74 20 3b 0a 3a 20 6e esend ?nat ;.: n
24b0: 6f 2d 6e 61 74 2d 64 6f 6e 65 20 28 20 6e 20 2d o-nat-done ( n -
24c0: 2d 20 29 0a 20 20 20 20 6e 61 74 28 20 2e 22 20 - ). nat( ."
24d0: 72 65 71 20 64 6f 6e 65 2c 20 66 69 6e 69 73 68 req done, finish
24e0: 65 64 22 20 66 6f 72 74 68 3a 63 72 20 29 0a 20 ed" forth:cr ).
24f0: 20 20 20 63 6f 6e 6e 65 63 74 2d 72 65 73 74 20 connect-rest
2500: 2b 66 6c 6f 77 2d 63 6f 6e 74 72 6f 6c 20 2b 72 +flow-control +r
2510: 65 73 65 6e 64 20 3b 0a 3a 20 64 69 72 65 63 74 esend ;.: direct
2520: 2d 63 6f 6e 6e 65 63 74 20 28 20 63 6d 64 6c 65 -connect ( cmdle
2530: 6e 20 64 61 74 61 6c 65 6e 20 2d 2d 20 29 0a 20 n datalen -- ).
2540: 20 20 20 63 6d 64 30 28 20 2e 22 20 61 74 74 65 cmd0( ." atte
2550: 6d 70 74 20 74 6f 20 63 6f 6e 6e 65 63 74 20 74 mpt to connect t
2560: 6f 3a 20 22 20 72 65 74 75 72 6e 2d 61 64 64 72 o: " return-addr
2570: 20 2e 61 64 64 72 2d 70 61 74 68 20 63 72 20 29 .addr-path cr )
2580: 0a 20 20 20 20 5b 27 5d 20 3f 6e 61 74 2d 64 6f . ['] ?nat-do
2590: 6e 65 20 5b 27 5d 20 6e 6f 2d 6e 61 74 2d 64 6f ne ['] no-nat-do
25a0: 6e 65 20 69 6e 64 2d 61 64 64 72 20 40 20 73 65 ne ind-addr @ se
25b0: 6c 65 63 74 20 72 71 64 3f 0a 20 20 20 20 6e 65 lect rqd?. ne
25c0: 74 32 6f 3a 63 6f 6e 6e 65 63 74 20 6e 61 74 28 t2o:connect nat(
25d0: 20 2e 22 20 63 6f 6e 6e 65 63 74 65 64 22 20 66 ." connected" f
25e0: 6f 72 74 68 3a 63 72 20 29 20 3b 0a 0a 3a 20 70 orth:cr ) ;..: p
25f0: 6b 2d 63 6f 6e 6e 65 63 74 20 28 20 61 64 64 72 k-connect ( addr
2600: 20 75 20 63 6d 64 6c 65 6e 20 64 61 74 61 6c 65 u cmdlen datale
2610: 6e 20 2d 2d 20 29 0a 20 20 20 20 32 3e 72 20 6e n -- ). 2>r n
2620: 65 74 32 6f 3a 70 6b 6c 6f 6f 6b 75 70 20 32 72 et2o:pklookup 2r
2630: 3e 20 64 69 72 65 63 74 2d 63 6f 6e 6e 65 63 74 > direct-connect
2640: 20 3b 0a 3a 20 70 6b 2d 63 6f 6e 6e 65 63 74 3f ;.: pk-connect?
2650: 20 28 20 61 64 64 72 20 75 20 63 6d 64 6c 65 6e ( addr u cmdlen
2660: 20 64 61 74 61 6c 65 6e 20 2d 2d 20 66 6c 61 67 datalen -- flag
2670: 20 29 0a 20 20 20 20 32 3e 72 20 6e 65 74 32 6f ). 2>r net2o
2680: 3a 70 6b 6c 6f 6f 6b 75 70 3f 20 64 75 70 20 49 :pklookup? dup I
2690: 46 20 20 20 32 72 3e 20 64 69 72 65 63 74 2d 63 F 2r> direct-c
26a0: 6f 6e 6e 65 63 74 20 20 45 4c 53 45 20 20 32 72 onnect ELSE 2r
26b0: 64 72 6f 70 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 drop THEN ;..:
26c0: 61 64 64 72 2d 63 6f 6e 6e 65 63 74 20 28 20 61 addr-connect ( a
26d0: 64 64 72 2b 6b 65 79 20 75 20 63 6d 64 6c 65 6e ddr+key u cmdlen
26e0: 20 64 61 74 61 6c 65 6e 20 78 74 20 2d 2d 20 29 datalen xt -- )
26f0: 0a 20 20 20 20 2d 72 6f 74 20 32 3e 72 20 3e 72 . -rot 2>r >r
2700: 20 6f 76 65 72 20 2b 20 31 2d 20 64 75 70 20 63 over + 1- dup c
2710: 40 20 64 75 70 20 3e 72 20 2d 0a 20 20 20 20 32 @ dup >r -. 2
2720: 64 75 70 20 75 3e 3d 20 21 21 6b 65 79 73 69 7a dup u>= !!keysiz
2730: 65 21 21 0a 20 20 20 20 64 75 70 20 72 3e 20 6d e!!. dup r> m
2740: 61 6b 65 2d 63 6f 6e 74 65 78 74 0a 20 20 20 20 ake-context.
2750: 6f 76 65 72 20 2d 20 69 6e 73 65 72 74 2d 61 64 over - insert-ad
2760: 64 72 24 20 30 3d 20 21 21 6e 6f 2d 61 64 64 72 dr$ 0= !!no-addr
2770: 65 73 73 21 21 0a 20 20 20 20 72 3e 20 65 78 65 ess!!. r> exe
2780: 63 75 74 65 20 32 72 3e 20 6e 65 74 32 6f 3a 63 cute 2r> net2o:c
2790: 6f 6e 6e 65 63 74 20 3b 0a 0a 3a 20 6e 69 63 6b onnect ;..: nick
27a0: 2d 63 6f 6e 6e 65 63 74 20 28 20 61 64 64 72 20 -connect ( addr
27b0: 75 20 63 6d 64 6c 65 6e 20 64 61 74 61 6c 65 6e u cmdlen datalen
27c0: 20 2d 2d 20 29 0a 20 20 20 20 32 3e 72 20 68 6f -- ). 2>r ho
27d0: 73 74 2e 6e 69 63 6b 3e 70 6b 20 32 72 3e 20 70 st.nick>pk 2r> p
27e0: 6b 2d 63 6f 6e 6e 65 63 74 20 3b 0a 0a 5c 20 73 k-connect ;..\ s
27f0: 65 61 72 63 68 20 6b 65 79 73 0a 0a 55 73 65 72 earch keys..User
2800: 20 73 65 61 72 63 68 2d 6b 65 79 5b 5d 0a 55 73 search-key[].Us
2810: 65 72 20 70 69 6e 67 73 5b 5d 0a 0a 3a 20 73 65 er pings[]..: se
2820: 61 72 63 68 2d 6b 65 79 73 20 28 20 2d 2d 20 29 arch-keys ( -- )
2830: 0a 20 20 20 20 64 68 74 2d 63 6f 6e 6e 65 63 74 . dht-connect
2840: 0a 20 20 20 20 6e 65 74 32 6f 2d 63 6f 64 65 20 . net2o-code
2850: 20 65 78 70 65 63 74 2d 72 65 70 6c 79 0a 20 20 expect-reply.
2860: 20 20 73 65 61 72 63 68 2d 6b 65 79 5b 5d 20 5b search-key[] [
2870: 3a 20 24 2c 20 64 68 74 2d 69 64 20 64 68 74 2d : $, dht-id dht-
2880: 6f 77 6e 65 72 3f 20 65 6e 64 2d 77 69 74 68 20 owner? end-with
2890: 3b 5d 20 24 5b 5d 6d 61 70 0a 20 20 20 20 63 6f ;] $[]map. co
28a0: 6f 6b 69 65 2b 72 65 71 75 65 73 74 20 65 6e 64 okie+request end
28b0: 2d 63 6f 64 65 7c 20 3b 0a 0a 3a 20 73 65 61 72 -code| ;..: sear
28c0: 63 68 2d 61 64 64 72 73 20 28 20 2d 2d 20 29 0a ch-addrs ( -- ).
28d0: 20 20 20 20 64 68 74 2d 63 6f 6e 6e 65 63 74 0a dht-connect.
28e0: 20 20 20 20 6e 65 74 32 6f 2d 63 6f 64 65 20 20 net2o-code
28f0: 65 78 70 65 63 74 2d 72 65 70 6c 79 0a 20 20 20 expect-reply.
2900: 20 73 65 61 72 63 68 2d 6b 65 79 5b 5d 20 5b 3a search-key[] [:
2910: 20 24 2c 20 64 68 74 2d 69 64 20 64 68 74 2d 68 $, dht-id dht-h
2920: 6f 73 74 3f 20 65 6e 64 2d 77 69 74 68 20 3b 5d ost? end-with ;]
2930: 20 24 5b 5d 6d 61 70 0a 20 20 20 20 63 6f 6f 6b $[]map. cook
2940: 69 65 2b 72 65 71 75 65 73 74 20 65 6e 64 2d 63 ie+request end-c
2950: 6f 64 65 7c 20 3b 0a 0a 3a 20 69 6e 73 65 72 74 ode| ;..: insert
2960: 2d 6b 65 79 73 20 28 20 2d 2d 20 29 0a 20 20 20 -keys ( -- ).
2970: 20 64 65 66 61 75 6c 74 6b 65 79 20 40 20 3e 73 defaultkey @ >s
2980: 74 6f 72 65 6b 65 79 20 21 0a 20 20 20 20 69 6d torekey !. im
2990: 70 6f 72 74 23 64 68 74 20 69 6d 70 6f 72 74 2d port#dht import-
29a0: 74 79 70 65 20 21 0a 20 20 20 20 73 65 61 72 63 type !. searc
29b0: 68 2d 6b 65 79 5b 5d 20 5b 3a 20 3e 64 23 69 64 h-key[] [: >d#id
29c0: 20 3e 6f 0a 20 20 20 20 20 20 30 20 64 68 74 2d >o. 0 dht-
29d0: 6f 77 6e 65 72 20 24 5b 5d 40 20 6e 69 70 20 73 owner $[]@ nip s
29e0: 69 67 73 69 7a 65 23 20 75 3e 20 49 46 0a 09 20 igsize# u> IF..
29f0: 20 36 34 23 2d 31 20 6b 65 79 2d 72 65 61 64 2d 64#-1 key-read-
2a00: 6f 66 66 73 65 74 20 36 34 21 0a 09 20 20 5b 3a offset 64!.. [:
2a10: 20 30 20 64 68 74 2d 6f 77 6e 65 72 20 24 5b 5d 0 dht-owner $[]
2a20: 40 20 32 64 75 70 20 73 69 67 73 69 7a 65 23 20 @ 2dup sigsize#
2a30: 2d 20 74 75 63 6b 20 74 79 70 65 20 2f 73 74 72 - tuck type /str
2a40: 69 6e 67 0a 09 20 20 20 20 64 68 74 2d 68 61 73 ing.. dht-has
2a50: 68 20 24 2e 20 74 79 70 65 20 3b 5d 20 24 74 6d h $. type ;] $tm
2a60: 70 0a 09 20 20 6b 65 79 3a 6e 65 73 74 2d 73 69 p.. key:nest-si
2a70: 67 20 30 3d 20 49 46 20 20 64 6f 2d 6e 65 73 74 g 0= IF do-nest
2a80: 73 69 67 0a 09 20 20 20 20 20 20 70 65 72 6d 25 sig.. perm%
2a90: 64 65 66 61 75 6c 74 20 6b 65 2d 6d 61 73 6b 20 default ke-mask
2aa0: 21 20 6e 3a 6f 3e 20 20 45 4c 53 45 20 20 32 64 ! n:o> ELSE 2d
2ab0: 72 6f 70 20 20 54 48 45 4e 0a 20 20 20 20 20 20 rop THEN.
2ac0: 54 48 45 4e 0a 20 20 20 20 20 20 6f 3e 20 3b 5d THEN. o> ;]
2ad0: 20 24 5b 5d 6d 61 70 20 3b 0a 0a 3a 20 73 65 6e $[]map ;..: sen
2ae0: 64 2d 70 69 6e 67 20 28 20 61 64 64 72 20 75 20 d-ping ( addr u
2af0: 2d 2d 20 29 20 73 69 67 73 69 7a 65 23 20 2d 20 -- ) sigsize# -
2b00: 6e 65 77 2d 61 64 64 72 20 64 75 70 20 3e 72 0a new-addr dup >r.
2b10: 20 20 20 20 5b 3a 20 72 65 74 2d 61 64 64 72 20 [: ret-addr
2b20: 24 31 30 20 65 72 61 73 65 0a 09 63 68 65 63 6b $10 erase..check
2b30: 2d 61 64 64 72 31 20 49 46 0a 09 20 20 20 20 32 -addr1 IF.. 2
2b40: 64 75 70 20 2e 61 64 64 72 65 73 73 20 66 6f 72 dup .address for
2b50: 74 68 3a 63 72 0a 09 20 20 20 20 69 6e 73 65 72 th:cr.. inser
2b60: 74 2d 61 64 64 72 65 73 73 20 72 65 74 2d 61 64 t-address ret-ad
2b70: 64 72 20 69 6e 73 2d 64 65 73 74 0a 09 20 20 20 dr ins-dest..
2b80: 20 6e 65 74 32 6f 2d 63 6f 64 65 30 20 6e 65 74 net2o-code0 net
2b90: 32 6f 2d 76 65 72 73 69 6f 6e 20 24 2c 20 76 65 2o-version $, ve
2ba0: 72 73 69 6f 6e 3f 0a 09 20 20 20 20 65 6e 64 2d rsion?.. end-
2bb0: 63 6f 64 65 0a 09 45 4c 53 45 20 20 32 64 72 6f code..ELSE 2dro
2bc0: 70 20 20 54 48 45 4e 20 3b 5d 20 61 64 64 72 3e p THEN ;] addr>
2bd0: 73 6f 63 6b 0a 20 20 20 20 72 3e 20 2e 6e 65 74 sock. r> .net
2be0: 32 6f 3a 64 69 73 70 6f 73 65 2d 61 64 64 72 20 2o:dispose-addr
2bf0: 3b 0a 0a 3a 20 72 65 63 65 69 76 65 2d 70 69 6e ;..: receive-pin
2c00: 67 73 20 28 20 2d 2d 20 29 0a 20 20 20 20 72 65 gs ( -- ). re
2c10: 71 75 65 73 74 73 2d 3e 30 20 3b 0a 0a 3a 20 64 quests->0 ;..: d
2c20: 68 74 2d 6e 69 63 6b 3f 20 28 20 70 6b 20 75 20 ht-nick? ( pk u
2c30: 2d 2d 20 29 0a 20 20 20 20 64 75 70 20 34 20 3c -- ). dup 4 <
2c40: 20 49 46 20 20 32 64 72 6f 70 20 20 45 58 49 54 IF 2drop EXIT
2c50: 20 20 54 48 45 4e 0a 20 20 20 20 73 65 61 72 63 THEN. searc
2c60: 68 2d 6b 65 79 5b 5d 20 24 6f 66 66 20 73 65 61 h-key[] $off sea
2c70: 72 63 68 2d 6b 65 79 5b 5d 20 24 2b 5b 5d 21 0a rch-key[] $+[]!.
2c80: 20 20 20 20 73 65 61 72 63 68 2d 6b 65 79 73 20 search-keys
2c90: 69 6e 73 65 72 74 2d 6b 65 79 73 20 73 61 76 65 insert-keys save
2ca0: 2d 70 75 62 6b 65 79 73 20 3b 0a 0a 5c 20 63 6f -pubkeys ;..\ co
2cb0: 6e 6e 65 63 74 2c 20 64 69 73 63 6f 6e 6e 65 63 nnect, disconnec
2cc0: 74 20 64 65 62 75 67 0a 0a 3a 20 64 62 67 2d 63 t debug..: dbg-c
2cd0: 6f 6e 6e 65 63 74 20 28 20 2d 2d 20 29 20 20 63 onnect ( -- ) c
2ce0: 6f 6e 6e 65 63 74 28 20 3c 69 6e 66 6f 3e 0a 20 onnect( <info>.
2cf0: 20 20 20 2e 22 20 63 6f 6e 6e 65 63 74 65 64 20 ." connected
2d00: 66 72 6f 6d 3a 20 22 20 2e 63 6f 6e 2d 69 64 20 from: " .con-id
2d10: 3c 64 65 66 61 75 6c 74 3e 20 63 72 20 29 20 3b <default> cr ) ;
2d20: 0a 3a 20 64 62 67 2d 64 69 73 63 6f 6e 6e 65 63 .: dbg-disconnec
2d30: 74 20 28 20 2d 2d 20 29 20 63 6f 6e 6e 65 63 74 t ( -- ) connect
2d40: 28 20 3c 69 6e 66 6f 3e 0a 20 20 20 20 2e 22 20 ( <info>. ."
2d50: 64 69 73 63 6f 6e 6e 65 63 74 69 6e 67 3a 20 22 disconnecting: "
2d60: 20 2e 63 6f 6e 2d 69 64 20 3c 64 65 66 61 75 6c .con-id <defaul
2d70: 74 3e 20 63 72 20 29 20 3b 0a 27 20 64 62 67 2d t> cr ) ;.' dbg-
2d80: 63 6f 6e 6e 65 63 74 20 49 53 20 64 6f 2d 63 6f connect IS do-co
2d90: 6e 6e 65 63 74 0a 27 20 64 62 67 2d 64 69 73 63 nnect.' dbg-disc
2da0: 6f 6e 6e 65 63 74 20 49 53 20 64 6f 2d 64 69 73 onnect IS do-dis
2db0: 63 6f 6e 6e 65 63 74 0a 0a 5c 5c 5c 0a 4c 6f 63 connect..\\\.Loc
2dc0: 61 6c 20 56 61 72 69 61 62 6c 65 73 3a 0a 66 6f al Variables:.fo
2dd0: 72 74 68 2d 6c 6f 63 61 6c 2d 77 6f 72 64 73 3a rth-local-words:
2de0: 0a 20 20 20 20 28 0a 20 20 20 20 20 28 28 22 6e . (. (("n
2df0: 65 74 32 6f 3a 22 20 22 2b 6e 65 74 32 6f 3a 22 et2o:" "+net2o:"
2e00: 29 20 64 65 66 69 6e 69 74 69 6f 6e 2d 73 74 61 ) definition-sta
2e10: 72 74 65 72 20 28 66 6f 6e 74 2d 6c 6f 63 6b 2d rter (font-lock-
2e20: 6b 65 79 77 6f 72 64 2d 66 61 63 65 20 2e 20 31 keyword-face . 1
2e30: 29 0a 20 20 20 20 20 20 22 5b 20 5c 74 5c 6e 5d ). "[ \t\n]
2e40: 22 20 74 20 6e 61 6d 65 20 28 66 6f 6e 74 2d 6c " t name (font-l
2e50: 6f 63 6b 2d 66 75 6e 63 74 69 6f 6e 2d 6e 61 6d ock-function-nam
2e60: 65 2d 66 61 63 65 20 2e 20 33 29 29 0a 20 20 20 e-face . 3)).
2e70: 20 20 28 22 5b 61 2d 7a 30 2d 39 5d 2b 28 22 20 ("[a-z0-9]+("
2e80: 69 6d 6d 65 64 69 61 74 65 20 28 66 6f 6e 74 2d immediate (font-
2e90: 6c 6f 63 6b 2d 63 6f 6d 6d 65 6e 74 2d 66 61 63 lock-comment-fac
2ea0: 65 20 2e 20 31 29 0a 20 20 20 20 20 20 22 29 22 e . 1). ")"
2eb0: 20 6e 69 6c 20 63 6f 6d 6d 65 6e 74 20 28 66 6f nil comment (fo
2ec0: 6e 74 2d 6c 6f 63 6b 2d 63 6f 6d 6d 65 6e 74 2d nt-lock-comment-
2ed0: 66 61 63 65 20 2e 20 31 29 29 0a 20 20 20 20 29 face . 1)). )
2ee0: 0a 66 6f 72 74 68 2d 6c 6f 63 61 6c 2d 69 6e 64 .forth-local-ind
2ef0: 65 6e 74 2d 77 6f 72 64 73 3a 0a 20 20 20 20 28 ent-words:. (
2f00: 0a 20 20 20 20 20 28 28 22 6e 65 74 32 6f 3a 22 . (("net2o:"
2f10: 20 22 2b 6e 65 74 32 6f 3a 22 29 20 28 30 20 2e "+net2o:") (0 .
2f20: 20 32 29 20 28 30 20 2e 20 32 29 20 6e 6f 6e 2d 2) (0 . 2) non-
2f30: 69 6d 6d 65 64 69 61 74 65 29 0a 20 20 20 20 29 immediate). )
2f40: 0a 45 6e 64 3a 0a 5b 54 48 45 4e 5d 0a .End:.[THEN].