Hex Artifact Content
Not logged in

Artifact 9c42b56aef4959bf79e2ada3a0a5fd944534eab7:


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                                               .