Artifact
cb3a2c906145d7a2d26c27fd7d30523ec4028ff7:
- File
addr.fs
— part of check-in
[b806903ba8]
at
2018-04-09 13:52:31
on branch trunk
— Use vocabularies for net2o/n2o: prefix
(user:
bernd
size: 7853)
0000: 5c 20 6e 65 74 32 6f 20 74 65 6d 70 6c 61 74 65 \ net2o template
0010: 20 66 6f 72 20 6e 65 77 20 66 69 6c 65 73 0a 0a for new files..
0020: 5c 20 43 6f 70 79 72 69 67 68 74 20 28 43 29 20 \ Copyright (C)
0030: 32 30 31 35 20 20 20 42 65 72 6e 64 20 50 61 79 2015 Bernd Pay
0040: 73 61 6e 0a 0a 5c 20 54 68 69 73 20 70 72 6f 67 san..\ This prog
0050: 72 61 6d 20 69 73 20 66 72 65 65 20 73 6f 66 74 ram is free soft
0060: 77 61 72 65 3a 20 79 6f 75 20 63 61 6e 20 72 65 ware: you can re
0070: 64 69 73 74 72 69 62 75 74 65 20 69 74 20 61 6e distribute it an
0080: 64 2f 6f 72 20 6d 6f 64 69 66 79 0a 5c 20 69 74 d/or modify.\ it
0090: 20 75 6e 64 65 72 20 74 68 65 20 74 65 72 6d 73 under the terms
00a0: 20 6f 66 20 74 68 65 20 47 4e 55 20 41 66 66 65 of the GNU Affe
00b0: 72 6f 20 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 ro General Publi
00c0: 63 20 4c 69 63 65 6e 73 65 20 61 73 20 70 75 62 c License as pub
00d0: 6c 69 73 68 65 64 20 62 79 0a 5c 20 74 68 65 20 lished by.\ the
00e0: 46 72 65 65 20 53 6f 66 74 77 61 72 65 20 46 6f Free Software Fo
00f0: 75 6e 64 61 74 69 6f 6e 2c 20 65 69 74 68 65 72 undation, either
0100: 20 76 65 72 73 69 6f 6e 20 33 20 6f 66 20 74 68 version 3 of th
0110: 65 20 4c 69 63 65 6e 73 65 2c 20 6f 72 0a 5c 20 e License, or.\
0120: 28 61 74 20 79 6f 75 72 20 6f 70 74 69 6f 6e 29 (at your option)
0130: 20 61 6e 79 20 6c 61 74 65 72 20 76 65 72 73 69 any later versi
0140: 6f 6e 2e 0a 0a 5c 20 54 68 69 73 20 70 72 6f 67 on...\ This prog
0150: 72 61 6d 20 69 73 20 64 69 73 74 72 69 62 75 74 ram is distribut
0160: 65 64 20 69 6e 20 74 68 65 20 68 6f 70 65 20 74 ed in the hope t
0170: 68 61 74 20 69 74 20 77 69 6c 6c 20 62 65 20 75 hat it will be u
0180: 73 65 66 75 6c 2c 0a 5c 20 62 75 74 20 57 49 54 seful,.\ but WIT
0190: 48 4f 55 54 20 41 4e 59 20 57 41 52 52 41 4e 54 HOUT ANY WARRANT
01a0: 59 3b 20 77 69 74 68 6f 75 74 20 65 76 65 6e 20 Y; without even
01b0: 74 68 65 20 69 6d 70 6c 69 65 64 20 77 61 72 72 the implied warr
01c0: 61 6e 74 79 20 6f 66 0a 5c 20 4d 45 52 43 48 41 anty of.\ MERCHA
01d0: 4e 54 41 42 49 4c 49 54 59 20 6f 72 20 46 49 54 NTABILITY or FIT
01e0: 4e 45 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 NESS FOR A PARTI
01f0: 43 55 4c 41 52 20 50 55 52 50 4f 53 45 2e 20 20 CULAR PURPOSE.
0200: 53 65 65 20 74 68 65 0a 5c 20 47 4e 55 20 41 66 See the.\ GNU Af
0210: 66 65 72 6f 20 47 65 6e 65 72 61 6c 20 50 75 62 fero General Pub
0220: 6c 69 63 20 4c 69 63 65 6e 73 65 20 66 6f 72 20 lic License for
0230: 6d 6f 72 65 20 64 65 74 61 69 6c 73 2e 0a 0a 5c more details...\
0240: 20 59 6f 75 20 73 68 6f 75 6c 64 20 68 61 76 65 You should have
0250: 20 72 65 63 65 69 76 65 64 20 61 20 63 6f 70 79 received a copy
0260: 20 6f 66 20 74 68 65 20 47 4e 55 20 41 66 66 65 of the GNU Affe
0270: 72 6f 20 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 ro General Publi
0280: 63 20 4c 69 63 65 6e 73 65 0a 5c 20 61 6c 6f 6e c License.\ alon
0290: 67 20 77 69 74 68 20 74 68 69 73 20 70 72 6f 67 g with this prog
02a0: 72 61 6d 2e 20 20 49 66 20 6e 6f 74 2c 20 73 65 ram. If not, se
02b0: 65 20 3c 68 74 74 70 3a 2f 2f 77 77 77 2e 67 6e e <http://www.gn
02c0: 75 2e 6f 72 67 2f 6c 69 63 65 6e 73 65 73 2f 3e u.org/licenses/>
02d0: 2e 0a 0a 5c 20 61 64 64 72 65 73 73 20 69 6e 74 ...\ address int
02e0: 65 72 70 72 65 74 65 72 0a 0a 73 63 6f 70 65 7b erpreter..scope{
02f0: 20 6e 65 74 32 6f 2d 62 61 73 65 0a 0a 63 6d 64 net2o-base..cmd
0300: 2d 74 61 62 6c 65 20 24 40 20 69 6e 68 65 72 69 -table $@ inheri
0310: 74 2d 74 61 62 6c 65 20 61 64 64 72 65 73 73 2d t-table address-
0320: 74 61 62 6c 65 0a 5c 67 20 0a 5c 67 20 23 23 23 table.\g .\g ###
0330: 20 61 64 64 72 65 73 73 20 63 6f 6d 6d 61 6e 64 address command
0340: 73 20 23 23 23 0a 5c 67 20 0a 0a 24 31 31 20 6e s ###.\g ..$11 n
0350: 65 74 32 6f 3a 20 61 64 64 72 2d 70 72 69 23 20 et2o: addr-pri#
0360: 28 20 6e 20 2d 2d 20 29 20 5c 67 20 70 72 69 6f ( n -- ) \g prio
0370: 72 69 74 79 0a 20 20 20 20 36 34 3e 6e 20 68 6f rity. 64>n ho
0380: 73 74 2d 70 72 69 23 20 21 20 3b 0a 2b 6e 65 74 st-pri# ! ;.+net
0390: 32 6f 3a 20 61 64 64 72 2d 69 64 20 28 20 24 3a 2o: addr-id ( $:
03a0: 69 64 20 2d 2d 20 29 20 5c 67 20 75 6e 69 71 75 id -- ) \g uniqu
03b0: 65 20 68 6f 73 74 20 69 64 20 73 74 72 69 6e 67 e host id string
03c0: 0a 20 20 20 20 24 3e 20 68 6f 73 74 2d 69 64 20 . $> host-id
03d0: 24 21 20 3b 0a 2b 6e 65 74 32 6f 3a 20 61 64 64 $! ;.+net2o: add
03e0: 72 2d 61 6e 63 68 6f 72 20 28 20 24 3a 70 75 62 r-anchor ( $:pub
03f0: 6b 65 79 20 2d 2d 20 29 20 5c 67 20 61 6e 63 68 key -- ) \g anch
0400: 6f 72 20 66 6f 72 20 72 6f 75 74 69 6e 67 20 66 or for routing f
0410: 75 72 74 68 65 72 0a 20 20 20 20 24 3e 20 68 6f urther. $> ho
0420: 73 74 2d 61 6e 63 68 6f 72 20 24 21 20 3b 0a 2b st-anchor $! ;.+
0430: 6e 65 74 32 6f 3a 20 61 64 64 72 2d 69 70 76 34 net2o: addr-ipv4
0440: 20 28 20 6e 20 2d 2d 20 29 20 5c 67 20 69 70 20 ( n -- ) \g ip
0450: 61 64 64 72 65 73 73 0a 20 20 20 20 36 34 3e 6e address. 64>n
0460: 20 68 6f 73 74 2d 69 70 76 34 20 62 65 2d 6c 21 host-ipv4 be-l!
0470: 20 3b 0a 2b 6e 65 74 32 6f 3a 20 61 64 64 72 2d ;.+net2o: addr-
0480: 69 70 76 36 20 28 20 24 3a 69 70 76 36 20 2d 2d ipv6 ( $:ipv6 --
0490: 20 29 20 5c 67 20 69 70 76 36 20 61 64 64 72 65 ) \g ipv6 addre
04a0: 73 73 0a 20 20 20 20 24 3e 20 68 6f 73 74 2d 69 ss. $> host-i
04b0: 70 76 36 20 24 31 30 20 73 6d 6f 76 65 20 3b 0a pv6 $10 smove ;.
04c0: 2b 6e 65 74 32 6f 3a 20 61 64 64 72 2d 70 6f 72 +net2o: addr-por
04d0: 74 76 34 20 28 20 6e 20 2d 2d 20 29 20 5c 67 20 tv4 ( n -- ) \g
04e0: 69 70 76 34 20 70 6f 72 74 0a 20 20 20 20 36 34 ipv4 port. 64
04f0: 3e 6e 20 68 6f 73 74 2d 70 6f 72 74 76 34 20 77 >n host-portv4 w
0500: 21 20 3b 0a 2b 6e 65 74 32 6f 3a 20 61 64 64 72 ! ;.+net2o: addr
0510: 2d 70 6f 72 74 76 36 20 28 20 6e 20 2d 2d 20 29 -portv6 ( n -- )
0520: 20 5c 67 20 69 70 76 36 20 70 6f 72 74 0a 20 20 \g ipv6 port.
0530: 20 20 36 34 3e 6e 20 68 6f 73 74 2d 70 6f 72 74 64>n host-port
0540: 76 34 20 77 21 20 3b 0a 2b 6e 65 74 32 6f 3a 20 v4 w! ;.+net2o:
0550: 61 64 64 72 2d 70 6f 72 74 20 28 20 6e 20 2d 2d addr-port ( n --
0560: 20 29 20 5c 67 20 69 70 20 70 6f 72 74 2c 20 62 ) \g ip port, b
0570: 6f 74 68 20 70 72 6f 74 6f 63 6f 6c 73 0a 20 20 oth protocols.
0580: 20 20 36 34 3e 6e 20 64 75 70 20 68 6f 73 74 2d 64>n dup host-
0590: 70 6f 72 74 76 34 20 77 21 20 68 6f 73 74 2d 70 portv4 w! host-p
05a0: 6f 72 74 76 36 20 77 21 20 3b 0a 2b 6e 65 74 32 ortv6 w! ;.+net2
05b0: 6f 3a 20 61 64 64 72 2d 72 6f 75 74 65 20 28 20 o: addr-route (
05c0: 24 3a 6e 65 74 32 6f 20 2d 2d 20 29 20 5c 67 20 $:net2o -- ) \g
05d0: 6e 65 74 32 6f 20 72 6f 75 74 69 6e 67 20 70 61 net2o routing pa
05e0: 72 74 0a 20 20 20 20 24 3e 20 68 6f 73 74 2d 72 rt. $> host-r
05f0: 6f 75 74 65 20 24 21 20 3b 0a 2b 6e 65 74 32 6f oute $! ;.+net2o
0600: 3a 20 61 64 64 72 2d 6b 65 79 20 28 20 24 3a 61 : addr-key ( $:a
0610: 64 64 72 20 2d 2d 20 29 20 5c 67 20 6b 65 79 20 ddr -- ) \g key
0620: 66 6f 72 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 73 for connection s
0630: 65 74 75 70 0a 20 20 20 20 24 3e 20 68 6f 73 74 etup. $> host
0640: 2d 6b 65 79 20 73 65 63 21 20 3b 0a 2b 6e 65 74 -key sec! ;.+net
0650: 32 6f 3a 20 61 64 64 72 2d 72 65 76 6f 6b 65 20 2o: addr-revoke
0660: 28 20 24 3a 72 65 76 6f 6b 65 20 2d 2d 20 29 20 ( $:revoke -- )
0670: 5c 67 20 72 65 76 6f 63 61 74 69 6f 6e 20 69 6e \g revocation in
0680: 66 6f 0a 20 20 20 20 24 3e 20 68 6f 73 74 2d 72 fo. $> host-r
0690: 65 76 6f 6b 65 20 24 21 20 3b 0a 2b 6e 65 74 32 evoke $! ;.+net2
06a0: 6f 3a 20 61 64 64 72 2d 65 6b 65 79 20 28 20 24 o: addr-ekey ( $
06b0: 3a 65 6b 65 79 20 74 69 6d 65 6f 75 74 20 2d 2d :ekey timeout --
06c0: 20 29 20 5c 67 20 65 70 68 65 6d 65 72 61 6c 20 ) \g ephemeral
06d0: 6b 65 79 0a 20 20 20 20 68 6f 73 74 2d 65 6b 65 key. host-eke
06e0: 79 2d 74 6f 20 36 34 21 20 24 3e 20 68 6f 73 74 y-to 64! $> host
06f0: 2d 65 6b 65 79 20 24 21 20 3b 0a 7d 73 63 6f 70 -ekey $! ;.}scop
0700: 65 0a 0a 67 65 6e 2d 74 61 62 6c 65 20 24 66 72 e..gen-table $fr
0710: 65 65 7a 65 0a 27 20 63 6f 6e 74 65 78 74 2d 74 eeze.' context-t
0720: 61 62 6c 65 20 69 73 20 67 65 6e 2d 74 61 62 6c able is gen-tabl
0730: 65 0a 0a 69 6e 20 6e 65 74 32 6f 20 3a 20 6e 65 e..in net2o : ne
0740: 77 2d 61 64 64 72 20 28 20 2d 2d 20 6f 20 29 0a w-addr ( -- o ).
0750: 20 20 20 20 61 64 64 72 65 73 73 2d 63 6c 61 73 address-clas
0760: 73 20 6e 65 77 20 3e 6f 20 20 61 64 64 72 65 73 s new >o addres
0770: 73 2d 74 61 62 6c 65 20 40 20 74 6f 6b 65 6e 2d s-table @ token-
0780: 74 61 62 6c 65 20 21 20 6f 20 6f 3e 20 3b 0a 69 table ! o o> ;.i
0790: 6e 20 6e 65 74 32 6f 20 3a 20 64 69 73 70 6f 73 n net2o : dispos
07a0: 65 2d 61 64 64 72 20 28 20 6f 3a 61 64 64 72 20 e-addr ( o:addr
07b0: 2d 2d 20 6f 3a 61 64 64 72 20 29 0a 20 20 20 20 -- o:addr ).
07c0: 68 6f 73 74 2d 69 64 20 24 6f 66 66 20 68 6f 73 host-id $off hos
07d0: 74 2d 61 6e 63 68 6f 72 20 24 6f 66 66 20 68 6f t-anchor $off ho
07e0: 73 74 2d 72 6f 75 74 65 20 24 6f 66 66 20 68 6f st-route $off ho
07f0: 73 74 2d 6b 65 79 20 73 65 63 2d 6f 66 66 0a 20 st-key sec-off.
0800: 20 20 20 68 6f 73 74 2d 72 65 76 6f 6b 65 20 24 host-revoke $
0810: 6f 66 66 20 3b 0a 69 6e 20 6e 65 74 32 6f 20 3a off ;.in net2o :
0820: 20 64 69 73 70 6f 73 65 2d 70 75 6e 63 68 73 20 dispose-punchs
0830: 28 20 2d 2d 20 29 0a 20 20 20 20 70 75 6e 63 68 ( -- ). punch
0840: 2d 61 64 64 72 73 20 24 40 20 62 6f 75 6e 64 73 -addrs $@ bounds
0850: 20 3f 44 4f 20 20 49 20 40 20 2e 6e 65 74 32 6f ?DO I @ .net2o
0860: 3a 64 69 73 70 6f 73 65 2d 61 64 64 72 20 20 63 :dispose-addr c
0870: 65 6c 6c 20 2b 4c 4f 4f 50 0a 20 20 20 20 70 75 ell +LOOP. pu
0880: 6e 63 68 2d 61 64 64 72 73 20 24 6f 66 66 20 3b nch-addrs $off ;
0890: 0a 3a 6e 6f 6e 61 6d 65 20 28 20 2d 2d 20 29 0a .:noname ( -- ).
08a0: 20 20 20 20 6e 65 74 32 6f 3a 64 69 73 70 6f 73 net2o:dispos
08b0: 65 2d 70 75 6e 63 68 73 20 20 64 65 66 65 72 73 e-punchs defers
08c0: 20 65 78 74 72 61 2d 64 69 73 70 6f 73 65 20 3b extra-dispose ;
08d0: 20 69 73 20 65 78 74 72 61 2d 64 69 73 70 6f 73 is extra-dispos
08e0: 65 0a 0a 3a 20 6e 65 77 2d 61 64 64 72 20 28 20 e..: new-addr (
08f0: 61 64 64 72 20 75 20 2d 2d 20 6f 20 29 20 5c 47 addr u -- o ) \G
0900: 20 63 72 65 61 74 65 20 61 20 6e 65 77 20 61 64 create a new ad
0910: 64 72 65 73 73 20 6f 62 6a 65 63 74 20 66 72 6f dress object fro
0920: 6d 20 73 74 72 69 6e 67 0a 20 20 20 20 6e 65 74 m string. net
0930: 32 6f 3a 6e 65 77 2d 61 64 64 72 20 6e 3a 3e 6f 2o:new-addr n:>o
0940: 20 6e 65 73 74 2d 63 6d 64 2d 6c 6f 6f 70 20 6f nest-cmd-loop o
0950: 20 6e 3a 6f 3e 20 3b 0a 0a 61 6c 73 6f 20 6e 65 n:o> ;..also ne
0960: 74 32 6f 2d 62 61 73 65 0a 3a 20 6f 2d 67 65 6e t2o-base.: o-gen
0970: 61 64 64 72 20 28 20 6f 20 2d 2d 20 29 20 3e 6f addr ( o -- ) >o
0980: 20 5c 47 20 63 72 65 61 74 65 20 6e 65 77 20 61 \G create new a
0990: 64 64 72 65 73 73 20 73 74 72 69 6e 67 20 66 72 ddress string fr
09a0: 6f 6d 20 6f 62 6a 65 63 74 0a 20 20 20 20 68 6f om object. ho
09b0: 73 74 2d 70 72 69 23 20 40 20 75 6c 69 74 2c 20 st-pri# @ ulit,
09c0: 61 64 64 72 2d 70 72 69 23 0a 20 20 20 20 68 6f addr-pri#. ho
09d0: 73 74 2d 69 64 20 24 40 20 64 75 70 20 49 46 20 st-id $@ dup IF
09e0: 24 2c 20 61 64 64 72 2d 69 64 20 20 45 4c 53 45 $, addr-id ELSE
09f0: 20 20 32 64 72 6f 70 20 20 54 48 45 4e 0a 20 20 2drop THEN.
0a00: 20 20 68 6f 73 74 2d 61 6e 63 68 6f 72 20 24 40 host-anchor $@
0a10: 20 64 75 70 20 49 46 20 24 2c 20 61 64 64 72 2d dup IF $, addr-
0a20: 61 6e 63 68 6f 72 20 20 45 4c 53 45 20 20 32 64 anchor ELSE 2d
0a30: 72 6f 70 20 20 54 48 45 4e 0a 20 20 20 20 68 6f rop THEN. ho
0a40: 73 74 2d 69 70 76 34 20 62 65 2d 75 6c 40 20 3f st-ipv4 be-ul@ ?
0a50: 64 75 70 2d 49 46 20 75 6c 69 74 2c 20 61 64 64 dup-IF ulit, add
0a60: 72 2d 69 70 76 34 20 20 54 48 45 4e 0a 20 20 20 r-ipv4 THEN.
0a70: 20 68 6f 73 74 2d 69 70 76 36 20 69 70 36 3f 20 host-ipv6 ip6?
0a80: 49 46 20 20 68 6f 73 74 2d 69 70 76 36 20 24 31 IF host-ipv6 $1
0a90: 30 20 24 2c 20 61 64 64 72 2d 69 70 76 36 20 20 0 $, addr-ipv6
0aa0: 54 48 45 4e 0a 20 20 20 20 68 6f 73 74 2d 70 6f THEN. host-po
0ab0: 72 74 76 34 20 77 40 20 68 6f 73 74 2d 70 6f 72 rtv4 w@ host-por
0ac0: 74 76 36 20 77 40 20 3d 20 49 46 0a 09 68 6f 73 tv6 w@ = IF..hos
0ad0: 74 2d 70 6f 72 74 76 34 20 77 40 20 75 6c 69 74 t-portv4 w@ ulit
0ae0: 2c 20 61 64 64 72 2d 70 6f 72 74 0a 20 20 20 20 , addr-port.
0af0: 45 4c 53 45 0a 09 68 6f 73 74 2d 70 6f 72 74 76 ELSE..host-portv
0b00: 34 20 77 40 20 3f 64 75 70 2d 49 46 20 20 75 6c 4 w@ ?dup-IF ul
0b10: 69 74 2c 20 61 64 64 72 2d 70 6f 72 74 76 34 20 it, addr-portv4
0b20: 20 54 48 45 4e 0a 09 68 6f 73 74 2d 70 6f 72 74 THEN..host-port
0b30: 76 36 20 77 40 20 3f 64 75 70 2d 49 46 20 20 75 v6 w@ ?dup-IF u
0b40: 6c 69 74 2c 20 61 64 64 72 2d 70 6f 72 74 76 36 lit, addr-portv6
0b50: 20 20 54 48 45 4e 0a 20 20 20 20 54 48 45 4e 0a THEN. THEN.
0b60: 20 20 20 20 68 6f 73 74 2d 72 6f 75 74 65 20 24 host-route $
0b70: 40 20 64 75 70 20 49 46 20 20 24 2c 20 61 64 64 @ dup IF $, add
0b80: 72 2d 72 6f 75 74 65 20 20 45 4c 53 45 20 20 32 r-route ELSE 2
0b90: 64 72 6f 70 20 20 54 48 45 4e 0a 20 20 20 20 68 drop THEN. h
0ba0: 6f 73 74 2d 6b 65 79 20 73 65 63 40 20 64 75 70 ost-key sec@ dup
0bb0: 20 49 46 20 20 73 65 63 24 2c 20 61 64 64 72 2d IF sec$, addr-
0bc0: 6b 65 79 20 20 45 4c 53 45 20 20 32 64 72 6f 70 key ELSE 2drop
0bd0: 20 20 54 48 45 4e 0a 20 20 20 20 68 6f 73 74 2d THEN. host-
0be0: 65 6b 65 79 20 24 40 20 64 75 70 20 49 46 20 20 ekey $@ dup IF
0bf0: 24 2c 20 68 6f 73 74 2d 65 6b 65 79 2d 74 6f 20 $, host-ekey-to
0c00: 36 34 40 20 75 6c 69 74 2c 20 61 64 64 72 2d 65 64@ ulit, addr-e
0c10: 6b 65 79 20 20 45 4c 53 45 20 20 32 64 72 6f 70 key ELSE 2drop
0c20: 20 20 54 48 45 4e 0a 20 20 20 20 68 6f 73 74 2d THEN. host-
0c30: 72 65 76 6f 6b 65 20 24 40 20 64 75 70 20 49 46 revoke $@ dup IF
0c40: 20 20 24 2c 20 61 64 64 72 2d 72 65 76 6f 6b 65 $, addr-revoke
0c50: 20 20 45 4c 53 45 20 20 32 64 72 6f 70 20 20 54 ELSE 2drop T
0c60: 48 45 4e 20 6f 3e 20 3b 20 0a 70 72 65 76 69 6f HEN o> ; .previo
0c70: 75 73 0a 3a 20 6f 3e 61 64 64 72 20 28 20 6f 20 us.: o>addr ( o
0c80: 2d 2d 20 61 64 64 72 20 75 20 29 0a 20 20 20 20 -- addr u ).
0c90: 63 6d 64 62 75 66 2d 6f 20 40 20 3e 72 20 63 6f cmdbuf-o @ >r co
0ca0: 64 65 2d 62 75 66 24 20 63 6d 64 72 65 73 65 74 de-buf$ cmdreset
0cb0: 20 6f 2d 67 65 6e 61 64 64 72 20 63 6d 64 62 75 o-genaddr cmdbu
0cc0: 66 24 20 72 3e 20 63 6d 64 62 75 66 2d 6f 20 21 f$ r> cmdbuf-o !
0cd0: 20 3b 0a 0a 3a 20 2e 61 64 64 72 20 28 20 6f 20 ;..: .addr ( o
0ce0: 2d 2d 20 29 20 5c 47 20 70 72 69 6e 74 20 61 64 -- ) \G print ad
0cf0: 64 72 0a 20 20 20 20 3e 6f 0a 20 20 20 20 68 6f dr. >o. ho
0d00: 73 74 2d 70 72 69 23 20 40 20 3f 64 75 70 2d 49 st-pri# @ ?dup-I
0d10: 46 20 20 30 20 2e 72 20 27 23 27 20 65 6d 69 74 F 0 .r '#' emit
0d20: 20 20 54 48 45 4e 0a 20 20 20 20 68 6f 73 74 2d THEN. host-
0d30: 69 64 20 24 40 20 64 75 70 20 49 46 20 27 22 27 id $@ dup IF '"'
0d40: 20 65 6d 69 74 20 74 79 70 65 20 27 22 27 20 65 emit type '"' e
0d50: 6d 69 74 20 20 45 4c 53 45 20 20 32 64 72 6f 70 mit ELSE 2drop
0d60: 20 20 54 48 45 4e 0a 20 20 20 20 68 6f 73 74 2d THEN. host-
0d70: 61 6e 63 68 6f 72 20 24 40 20 64 75 70 20 49 46 anchor $@ dup IF
0d80: 20 2e 22 20 61 6e 63 68 6f 72 3a 20 22 20 38 35 ." anchor: " 85
0d90: 74 79 70 65 20 63 72 20 20 45 4c 53 45 20 20 32 type cr ELSE 2
0da0: 64 72 6f 70 20 20 54 48 45 4e 0a 20 20 20 20 68 drop THEN. h
0db0: 6f 73 74 2d 69 70 76 36 20 69 70 36 3f 20 49 46 ost-ipv6 ip6? IF
0dc0: 20 20 68 6f 73 74 2d 69 70 76 36 20 24 31 30 20 host-ipv6 $10
0dd0: 2e 69 70 36 61 20 32 64 72 6f 70 0a 09 68 6f 73 .ip6a 2drop..hos
0de0: 74 2d 70 6f 72 74 76 34 20 77 40 20 68 6f 73 74 t-portv4 w@ host
0df0: 2d 70 6f 72 74 76 36 20 77 40 20 3c 3e 20 49 46 -portv6 w@ <> IF
0e00: 20 20 68 6f 73 74 2d 70 6f 72 74 76 36 20 77 40 host-portv6 w@
0e10: 20 2e 22 20 3a 22 20 30 20 2e 72 20 73 70 61 63 ." :" 0 .r spac
0e20: 65 20 54 48 45 4e 0a 20 20 20 20 54 48 45 4e 0a e THEN. THEN.
0e30: 20 20 20 20 68 6f 73 74 2d 69 70 76 34 20 62 65 host-ipv4 be
0e40: 2d 75 6c 40 20 64 75 70 20 49 46 20 68 6f 73 74 -ul@ dup IF host
0e50: 2d 69 70 76 34 20 34 20 2e 69 70 34 61 20 32 64 -ipv4 4 .ip4a 2d
0e60: 72 6f 70 20 20 54 48 45 4e 0a 20 20 20 20 68 6f rop THEN. ho
0e70: 73 74 2d 70 6f 72 74 76 34 20 77 40 20 68 6f 73 st-portv4 w@ hos
0e80: 74 2d 70 6f 72 74 76 36 20 77 40 20 3d 20 6f 72 t-portv6 w@ = or
0e90: 20 20 49 46 20 68 6f 73 74 2d 70 6f 72 74 76 34 IF host-portv4
0ea0: 20 77 40 20 2e 22 20 3a 22 20 30 20 2e 72 20 20 w@ ." :" 0 .r
0eb0: 54 48 45 4e 0a 20 20 20 20 68 6f 73 74 2d 72 6f THEN. host-ro
0ec0: 75 74 65 20 24 40 20 64 75 70 20 49 46 20 20 27 ute $@ dup IF '
0ed0: 7c 27 20 65 6d 69 74 20 78 74 79 70 65 20 20 45 |' emit xtype E
0ee0: 4c 53 45 20 20 32 64 72 6f 70 20 20 54 48 45 4e LSE 2drop THEN
0ef0: 0a 20 20 20 20 68 6f 73 74 2d 6b 65 79 20 73 65 . host-key se
0f00: 63 40 20 64 75 70 20 49 46 20 20 27 24 27 20 65 c@ dup IF '$' e
0f10: 6d 69 74 20 2e 62 6c 61 63 6b 38 35 20 20 45 4c mit .black85 EL
0f20: 53 45 20 20 32 64 72 6f 70 20 20 54 48 45 4e 0a SE 2drop THEN.
0f30: 20 20 20 20 6f 3e 20 3b 20 0a 0a 3a 20 2e 6e 61 o> ; ..: .na
0f40: 74 2d 61 64 64 72 73 20 28 20 2d 2d 20 29 0a 20 t-addrs ( -- ).
0f50: 20 20 20 70 75 6e 63 68 2d 61 64 64 72 73 20 24 punch-addrs $
0f60: 40 20 62 6f 75 6e 64 73 20 3f 44 4f 20 20 49 20 @ bounds ?DO I
0f70: 40 20 2e 61 64 64 72 20 63 72 20 20 63 65 6c 6c @ .addr cr cell
0f80: 20 2b 4c 4f 4f 50 20 3b 0a 0a 3a 20 2e 61 64 64 +LOOP ;..: .add
0f90: 72 24 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 r$ ( addr u -- )
0fa0: 0a 20 20 20 20 6e 65 77 2d 61 64 64 72 20 3e 6f . new-addr >o
0fb0: 20 6f 20 2e 61 64 64 72 20 6e 65 74 32 6f 3a 64 o .addr net2o:d
0fc0: 69 73 70 6f 73 65 2d 61 64 64 72 20 6f 3e 20 3b ispose-addr o> ;
0fd0: 0a 0a 55 73 65 72 20 64 65 73 74 2d 30 6b 65 79 ..User dest-0key
0fe0: 3e 20 5c 20 70 6f 69 6e 74 65 72 20 74 6f 20 64 > \ pointer to d
0ff0: 65 73 74 2d 30 6b 65 79 0a 55 73 65 72 20 64 65 est-0key.User de
1000: 73 74 2d 30 6b 65 79 3c 20 5c 20 70 6f 69 6e 74 st-0key< \ point
1010: 65 72 20 74 6f 20 6f 62 74 61 69 6e 65 64 20 64 er to obtained d
1020: 65 73 74 2d 30 6b 65 79 0a 0a 3a 20 61 64 64 72 est-0key..: addr
1030: 3e 36 73 6f 63 6b 20 28 20 2d 2d 20 29 0a 20 20 >6sock ( -- ).
1040: 20 20 68 6f 73 74 2d 6b 65 79 20 40 20 64 65 73 host-key @ des
1050: 74 2d 30 6b 65 79 3c 20 21 0a 20 20 20 20 68 6f t-0key< !. ho
1060: 73 74 2d 70 6f 72 74 76 36 20 77 40 20 73 6f 63 st-portv6 w@ soc
1070: 6b 61 64 64 72 31 20 70 6f 72 74 20 62 65 2d 77 kaddr1 port be-w
1080: 21 0a 20 20 20 20 68 6f 73 74 2d 69 70 76 36 20 !. host-ipv6
1090: 73 6f 63 6b 61 64 64 72 31 20 73 69 6e 36 5f 61 sockaddr1 sin6_a
10a0: 64 64 72 20 69 70 36 21 0a 20 20 20 20 68 6f 73 ddr ip6!. hos
10b0: 74 2d 72 6f 75 74 65 20 24 40 20 21 74 65 6d 70 t-route $@ !temp
10c0: 2d 61 64 64 72 20 3b 0a 0a 3a 20 61 64 64 72 3e -addr ;..: addr>
10d0: 34 73 6f 63 6b 20 28 20 2d 2d 20 29 0a 20 20 20 4sock ( -- ).
10e0: 20 68 6f 73 74 2d 6b 65 79 20 40 20 64 65 73 74 host-key @ dest
10f0: 2d 30 6b 65 79 3c 20 21 0a 20 20 20 20 68 6f 73 -0key< !. hos
1100: 74 2d 70 6f 72 74 76 34 20 77 40 20 73 6f 63 6b t-portv4 w@ sock
1110: 61 64 64 72 31 20 70 6f 72 74 20 62 65 2d 77 21 addr1 port be-w!
1120: 0a 20 20 20 20 68 6f 73 74 2d 69 70 76 34 20 62 . host-ipv4 b
1130: 65 2d 75 6c 40 20 73 6f 63 6b 61 64 64 72 31 20 e-ul@ sockaddr1
1140: 69 70 76 34 21 0a 20 20 20 20 68 6f 73 74 2d 72 ipv4!. host-r
1150: 6f 75 74 65 20 24 40 20 21 74 65 6d 70 2d 61 64 oute $@ !temp-ad
1160: 64 72 20 3b 0a 0a 3a 6e 6f 6e 61 6d 65 20 28 20 dr ;..:noname (
1170: 6f 20 78 74 20 2d 2d 20 29 20 7b 20 78 74 20 7d o xt -- ) { xt }
1180: 20 3e 6f 0a 20 20 20 20 69 70 76 34 28 20 68 6f >o. ipv4( ho
1190: 73 74 2d 69 70 76 34 20 62 65 2d 75 6c 40 20 49 st-ipv4 be-ul@ I
11a0: 46 20 20 61 64 64 72 3e 34 73 6f 63 6b 20 6f 20 F addr>4sock o
11b0: 6f 3e 20 3e 72 20 78 74 20 65 78 65 63 75 74 65 o> >r xt execute
11c0: 20 20 72 3e 20 3e 6f 20 54 48 45 4e 20 29 0a 20 r> >o THEN ).
11d0: 20 20 20 69 70 76 36 28 20 68 6f 73 74 2d 69 70 ipv6( host-ip
11e0: 76 36 20 69 70 36 3f 20 20 20 49 46 20 20 61 64 v6 ip6? IF ad
11f0: 64 72 3e 36 73 6f 63 6b 20 6f 20 6f 3e 20 3e 72 dr>6sock o o> >r
1200: 20 78 74 20 65 78 65 63 75 74 65 20 20 72 3e 20 xt execute r>
1210: 3e 6f 20 54 48 45 4e 20 29 0a 20 20 20 20 6f 3e >o THEN ). o>
1220: 20 3b 20 69 73 20 61 64 64 72 3e 73 6f 63 6b 0a ; is addr>sock.
1230: 0a 3a 20 2b 6d 79 2d 69 64 20 28 20 2d 2d 20 29 .: +my-id ( -- )
1240: 0a 20 20 20 20 63 6f 6e 66 69 67 3a 70 72 69 6f . config:prio
1250: 23 20 40 20 68 6f 73 74 2d 70 72 69 23 20 21 0a # @ host-pri# !.
1260: 20 20 20 20 68 6f 73 74 24 20 24 40 20 68 6f 73 host$ $@ hos
1270: 74 2d 69 64 20 24 21 0a 20 20 20 20 6d 79 2d 30 t-id $!. my-0
1280: 6b 65 79 20 40 20 49 46 20 20 6d 79 2d 30 6b 65 key @ IF my-0ke
1290: 79 20 73 65 63 40 20 68 6f 73 74 2d 6b 65 79 20 y sec@ host-key
12a0: 73 65 63 21 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 sec! THEN ;..:
12b0: 2b 6d 79 2d 61 64 64 72 73 20 28 20 70 6f 72 74 +my-addrs ( port
12c0: 20 6f 3a 61 64 64 72 20 2d 2d 20 29 0a 20 20 20 o:addr -- ).
12d0: 20 2b 6d 79 2d 69 64 0a 20 20 20 20 64 75 70 20 +my-id. dup
12e0: 68 6f 73 74 2d 70 6f 72 74 76 34 20 77 21 20 20 host-portv4 w!
12f0: 68 6f 73 74 2d 70 6f 72 74 76 36 20 77 21 0a 20 host-portv6 w!.
1300: 20 20 20 6f 20 6d 79 2d 61 64 64 72 5b 5d 20 24 o my-addr[] $
1310: 5b 5d 23 20 6d 79 2d 61 64 64 72 5b 5d 20 24 5b []# my-addr[] $[
1320: 5d 20 21 20 3b 0a 0a 3a 20 21 6d 79 2d 61 64 64 ] ! ;..: !my-add
1330: 72 73 20 28 20 2d 2d 20 29 20 6e 65 74 32 6f 3a rs ( -- ) net2o:
1340: 6e 65 77 2d 61 64 64 72 20 3e 6f 0a 20 20 20 20 new-addr >o.
1350: 67 6c 6f 62 61 6c 2d 69 70 36 20 74 75 63 6b 20 global-ip6 tuck
1360: 68 6f 73 74 2d 69 70 76 36 20 24 31 30 20 73 6d host-ipv6 $10 sm
1370: 6f 76 65 0a 20 20 20 20 67 6c 6f 62 61 6c 2d 69 ove. global-i
1380: 70 34 20 49 46 20 20 62 65 2d 75 6c 40 20 68 6f p4 IF be-ul@ ho
1390: 73 74 2d 69 70 76 34 20 62 65 2d 6c 21 20 20 45 st-ipv4 be-l! E
13a0: 4c 53 45 20 20 64 72 6f 70 20 20 54 48 45 4e 0a LSE drop THEN.
13b0: 20 20 20 20 6d 79 2d 70 6f 72 74 23 20 2b 6d 79 my-port# +my
13c0: 2d 61 64 64 72 73 20 6f 3e 0a 20 20 20 20 30 3d -addrs o>. 0=
13d0: 20 49 46 20 20 69 70 76 36 28 20 6c 6f 63 61 6c IF ipv6( local
13e0: 2d 69 70 36 20 20 49 46 0a 09 20 20 20 20 6e 65 -ip6 IF.. ne
13f0: 74 32 6f 3a 6e 65 77 2d 61 64 64 72 20 3e 6f 20 t2o:new-addr >o
1400: 20 68 6f 73 74 2d 69 70 76 36 20 69 70 36 21 20 host-ipv6 ip6!
1410: 20 6d 79 2d 70 6f 72 74 23 20 2b 6d 79 2d 61 64 my-port# +my-ad
1420: 64 72 73 20 20 6f 3e 0a 09 45 4c 53 45 20 20 64 drs o>..ELSE d
1430: 72 6f 70 20 20 54 48 45 4e 20 29 0a 20 20 20 20 rop THEN ).
1440: 54 48 45 4e 20 3b 0a 0a 3a 20 24 5b 5d 6f 2d 6d THEN ;..: $[]o-m
1450: 61 70 20 7b 20 61 64 64 72 20 78 74 20 2d 2d 20 ap { addr xt --
1460: 7d 0a 20 20 20 20 5c 47 20 65 78 65 63 75 74 65 }. \G execute
1470: 20 40 76 61 72 7b 78 74 7d 20 66 6f 72 20 61 6c @var{xt} for al
1480: 6c 20 65 6c 65 6d 65 6e 74 73 20 6f 66 20 74 68 l elements of th
1490: 65 20 6f 62 6a 65 63 74 20 61 72 72 61 79 20 40 e object array @
14a0: 76 61 72 7b 61 64 64 72 7d 2e 0a 20 20 20 20 5c var{addr}.. \
14b0: 47 20 78 74 20 69 73 20 40 76 61 72 7b 28 20 6f G xt is @var{( o
14c0: 20 2d 2d 20 29 7d 2c 20 67 65 74 74 69 6e 67 20 -- )}, getting
14d0: 6f 6e 65 20 73 74 72 69 6e 67 20 61 74 20 61 20 one string at a
14e0: 74 69 6d 65 0a 20 20 20 20 61 64 64 72 20 24 5b time. addr $[
14f0: 5d 23 20 30 20 3f 44 4f 20 20 49 20 61 64 64 72 ]# 0 ?DO I addr
1500: 20 24 5b 5d 20 40 20 78 74 20 65 78 65 63 75 74 $[] @ xt execut
1510: 65 20 20 4c 4f 4f 50 20 3b 0a 0a 3a 20 61 64 64 e LOOP ;..: add
1520: 72 73 2d 6f 66 66 20 28 20 2d 2d 20 29 0a 20 20 rs-off ( -- ).
1530: 20 20 5c 47 20 64 69 73 70 6f 73 65 20 61 6c 6c \G dispose all
1540: 20 61 64 64 72 65 73 73 65 73 0a 20 20 20 20 6d addresses. m
1550: 79 2d 61 64 64 72 5b 5d 20 5b 3a 20 2e 6e 65 74 y-addr[] [: .net
1560: 32 6f 3a 64 69 73 70 6f 73 65 2d 61 64 64 72 20 2o:dispose-addr
1570: 3b 5d 20 24 5b 5d 6f 2d 6d 61 70 0a 20 20 20 20 ;] $[]o-map.
1580: 6d 79 2d 61 64 64 72 5b 5d 20 24 6f 66 66 0a 20 my-addr[] $off.
1590: 20 20 20 6d 79 2d 61 64 64 72 24 20 24 5b 5d 6f my-addr$ $[]o
15a0: 66 66 0a 20 20 20 20 70 75 62 2d 61 64 64 72 24 ff. pub-addr$
15b0: 20 24 5b 5d 6f 66 66 0a 20 20 20 20 70 72 69 76 $[]off. priv
15c0: 2d 61 64 64 72 24 20 24 5b 5d 6f 66 66 20 3b 0a -addr$ $[]off ;.
15d0: 0a 3a 20 21 6d 79 2d 61 64 64 72 24 20 28 20 2d .: !my-addr$ ( -
15e0: 2d 20 29 0a 20 20 20 20 6d 79 2d 6b 65 79 2d 64 - ). my-key-d
15f0: 65 66 61 75 6c 74 20 30 3d 20 3f 45 58 49 54 0a efault 0= ?EXIT.
1600: 20 20 20 20 6e 6f 77 3e 6e 65 76 65 72 20 20 6d now>never m
1610: 79 2d 61 64 64 72 5b 5d 20 5b 3a 0a 20 20 20 20 y-addr[] [:.
1620: 20 20 6e 61 74 28 20 2e 22 20 69 6e 73 65 72 74 nat( ." insert
1630: 20 69 6e 74 6f 20 6d 79 2d 61 64 64 72 24 3a 20 into my-addr$:
1640: 22 20 64 75 70 20 2e 61 64 64 72 20 66 6f 72 74 " dup .addr fort
1650: 68 3a 63 72 20 29 0a 20 20 20 20 20 20 6f 3e 61 h:cr ). o>a
1660: 64 64 72 20 67 65 6e 2d 68 6f 73 74 20 6d 79 2d ddr gen-host my-
1670: 61 64 64 72 24 20 24 69 6e 73 5b 5d 73 69 67 20 addr$ $ins[]sig
1680: 64 72 6f 70 20 3b 5d 20 24 5b 5d 6f 2d 6d 61 70 drop ;] $[]o-map
1690: 20 3b 0a 0a 3a 20 2e 6d 79 2d 61 64 64 72 73 20 ;..: .my-addrs
16a0: 28 20 2d 2d 20 29 0a 20 20 20 20 6d 79 2d 61 64 ( -- ). my-ad
16b0: 64 72 5b 5d 20 5b 3a 20 2e 61 64 64 72 20 63 72 dr[] [: .addr cr
16c0: 20 3b 5d 20 24 5b 5d 6f 2d 6d 61 70 20 3b 0a 3a ;] $[]o-map ;.:
16d0: 20 2e 6d 79 2d 61 64 64 72 24 73 20 28 20 2d 2d .my-addr$s ( --
16e0: 20 29 0a 20 20 20 20 6d 79 2d 61 64 64 72 24 20 ). my-addr$
16f0: 5b 3a 20 73 69 67 73 69 7a 65 23 20 2d 20 2e 61 [: sigsize# - .a
1700: 64 64 72 24 20 63 72 20 3b 5d 20 24 5b 5d 6d 61 ddr$ cr ;] $[]ma
1710: 70 20 3b 0a 3a 20 2e 70 75 62 2d 61 64 64 72 24 p ;.: .pub-addr$
1720: 73 20 28 20 2d 2d 20 29 0a 20 20 20 20 70 75 62 s ( -- ). pub
1730: 2d 61 64 64 72 24 20 5b 3a 20 73 69 67 73 69 7a -addr$ [: sigsiz
1740: 65 23 20 2d 20 2e 61 64 64 72 24 20 63 72 20 3b e# - .addr$ cr ;
1750: 5d 20 24 5b 5d 6d 61 70 20 3b 0a 3a 20 2e 70 72 ] $[]map ;.: .pr
1760: 69 76 2d 61 64 64 72 24 73 20 28 20 2d 2d 20 29 iv-addr$s ( -- )
1770: 0a 20 20 20 20 70 72 69 76 2d 61 64 64 72 24 20 . priv-addr$
1780: 5b 3a 20 73 69 67 73 69 7a 65 23 20 2d 20 2e 61 [: sigsize# - .a
1790: 64 64 72 24 20 63 72 20 3b 5d 20 24 5b 5d 6d 61 ddr$ cr ;] $[]ma
17a0: 70 20 3b 0a 0a 3a 20 21 6d 79 2d 61 64 64 72 20 p ;..: !my-addr
17b0: 28 20 2d 2d 20 29 20 61 64 64 72 73 2d 6f 66 66 ( -- ) addrs-off
17c0: 20 21 6d 79 2d 61 64 64 72 73 20 21 6d 79 2d 61 !my-addrs !my-a
17d0: 64 64 72 24 20 3b 0a 0a 5c 20 6d 65 72 67 65 20 ddr$ ;..\ merge
17e0: 61 64 64 72 65 73 73 65 73 0a 0a 3a 20 6d 79 2d addresses..: my-
17f0: 61 64 64 72 3d 20 28 20 6f 31 20 6f 3a 6f 32 20 addr= ( o1 o:o2
1800: 2d 2d 20 29 20 7b 20 6f 31 20 7d 0a 20 20 20 20 -- ) { o1 }.
1810: 6f 31 20 2e 68 6f 73 74 2d 70 6f 72 74 76 34 20 o1 .host-portv4
1820: 32 20 68 6f 73 74 2d 70 6f 72 74 76 34 20 6f 76 2 host-portv4 ov
1830: 65 72 20 73 74 72 3d 3f 30 20 26 26 0a 20 20 20 er str=?0 &&.
1840: 20 6f 31 20 2e 68 6f 73 74 2d 70 6f 72 74 76 36 o1 .host-portv6
1850: 20 32 20 68 6f 73 74 2d 70 6f 72 74 76 36 20 6f 2 host-portv6 o
1860: 76 65 72 20 73 74 72 3d 3f 30 20 26 26 0a 20 20 ver str=?0 &&.
1870: 20 20 6f 31 20 2e 68 6f 73 74 2d 72 6f 75 74 65 o1 .host-route
1880: 20 24 40 20 68 6f 73 74 2d 72 6f 75 74 65 20 24 $@ host-route $
1890: 40 20 20 73 74 72 3d 3f 30 20 26 26 0a 20 20 20 @ str=?0 &&.
18a0: 20 6f 31 20 2e 68 6f 73 74 2d 69 70 76 34 20 20 o1 .host-ipv4
18b0: 20 34 20 68 6f 73 74 2d 69 70 76 34 20 6f 76 65 4 host-ipv4 ove
18c0: 72 20 73 74 72 3d 3f 30 20 26 26 0a 20 20 20 20 r str=?0 &&.
18d0: 6f 31 20 2e 68 6f 73 74 2d 69 70 76 36 20 24 31 o1 .host-ipv6 $1
18e0: 30 20 68 6f 73 74 2d 69 70 76 36 20 6f 76 65 72 0 host-ipv6 over
18f0: 20 73 74 72 3d 3f 30 20 3b 0a 0a 3a 20 6d 79 2d str=?0 ;..: my-
1900: 61 64 64 72 3f 20 28 20 6f 20 2d 2d 20 66 6c 61 addr? ( o -- fla
1910: 67 20 29 0a 20 20 20 20 66 61 6c 73 65 20 6d 79 g ). false my
1920: 2d 61 64 64 72 5b 5d 20 5b 3a 20 3e 6f 20 6f 76 -addr[] [: >o ov
1930: 65 72 20 6d 79 2d 61 64 64 72 3d 20 6f 3e 20 6f er my-addr= o> o
1940: 72 20 3b 5d 20 24 5b 5d 6f 2d 6d 61 70 20 6e 69 r ;] $[]o-map ni
1950: 70 20 3b 0a 0a 3a 20 6d 79 2d 61 64 64 72 2d 6d p ;..: my-addr-m
1960: 65 72 67 65 31 20 28 20 6f 31 20 6f 3a 6f 32 20 erge1 ( o1 o:o2
1970: 2d 2d 20 29 20 7b 20 6f 31 20 7d 0a 20 20 20 20 -- ) { o1 }.
1980: 6f 31 20 2e 68 6f 73 74 2d 69 70 76 34 20 20 20 o1 .host-ipv4
1990: 34 20 68 6f 73 74 2d 69 70 76 34 20 6f 76 65 72 4 host-ipv4 over
19a0: 20 73 74 72 3e 6d 65 72 67 65 0a 20 20 20 20 6f str>merge. o
19b0: 31 20 2e 68 6f 73 74 2d 69 70 76 36 20 24 31 30 1 .host-ipv6 $10
19c0: 20 68 6f 73 74 2d 69 70 76 36 20 6f 76 65 72 20 host-ipv6 over
19d0: 73 74 72 3e 6d 65 72 67 65 20 3b 0a 0a 3a 20 6d str>merge ;..: m
19e0: 79 2d 61 64 64 72 2d 6d 65 72 67 65 20 28 20 6f y-addr-merge ( o
19f0: 20 2d 2d 20 66 6c 61 67 20 29 0a 20 20 20 20 66 -- flag ). f
1a00: 61 6c 73 65 20 73 77 61 70 0a 20 20 20 20 6d 79 alse swap. my
1a10: 2d 61 64 64 72 5b 5d 20 5b 3a 20 3e 6f 20 64 75 -addr[] [: >o du
1a20: 70 20 6d 79 2d 61 64 64 72 3d 20 49 46 20 64 75 p my-addr= IF du
1a30: 70 20 6d 79 2d 61 64 64 72 2d 6d 65 72 67 65 31 p my-addr-merge1
1a40: 0a 09 6e 69 70 20 74 72 75 65 20 73 77 61 70 20 ..nip true swap
1a50: 54 48 45 4e 20 6f 3e 20 3b 5d 20 24 5b 5d 6f 2d THEN o> ;] $[]o-
1a60: 6d 61 70 0a 20 20 20 20 64 72 6f 70 20 3b 0a 0a map. drop ;..
1a70: 5c 20 73 6f 63 6b 61 64 64 72 20 63 6f 6e 76 65 \ sockaddr conve
1a80: 72 73 69 6f 6e 0a 0a 61 6c 73 6f 20 6e 65 74 32 rsion..also net2
1a90: 6f 2d 62 61 73 65 0a 3a 20 2e 73 6f 63 6b 61 64 o-base.: .sockad
1aa0: 64 72 20 28 20 61 64 64 72 20 61 6c 65 6e 20 2d dr ( addr alen -
1ab0: 2d 20 73 6f 63 6b 61 64 64 72 20 75 20 29 0a 20 - sockaddr u ).
1ac0: 20 20 20 5c 20 63 6f 6e 76 65 72 74 20 73 6f 63 \ convert soc
1ad0: 6b 65 74 20 69 6e 74 6f 20 6e 65 74 32 6f 20 61 ket into net2o a
1ae0: 64 64 72 65 73 73 20 74 6f 6b 65 6e 0a 20 20 20 ddress token.
1af0: 20 5b 3a 20 7b 20 61 64 64 72 20 61 6c 65 6e 20 [: { addr alen
1b00: 7d 0a 09 63 61 73 65 20 61 64 64 72 20 66 61 6d }..case addr fam
1b10: 69 6c 79 20 77 40 0a 09 20 20 20 20 41 46 5f 49 ily w@.. AF_I
1b20: 4e 45 54 20 6f 66 0a 09 09 61 64 64 72 20 73 69 NET of...addr si
1b30: 6e 5f 61 64 64 72 20 62 65 2d 75 6c 40 20 75 6c n_addr be-ul@ ul
1b40: 69 74 2c 20 61 64 64 72 2d 69 70 76 34 0a 09 20 it, addr-ipv4..
1b50: 20 20 20 65 6e 64 6f 66 0a 09 20 20 20 20 41 46 endof.. AF
1b60: 5f 49 4e 45 54 36 20 6f 66 0a 09 09 61 64 64 72 _INET6 of...addr
1b70: 20 73 69 6e 36 5f 61 64 64 72 20 31 32 20 66 61 sin6_addr 12 fa
1b80: 6b 65 2d 69 70 34 20 6f 76 65 72 20 73 74 72 3d ke-ip4 over str=
1b90: 20 49 46 0a 09 09 20 20 20 20 2e 69 70 36 3a 3a IF... .ip6::
1ba0: 30 20 61 64 64 72 20 73 69 6e 36 5f 61 64 64 72 0 addr sin6_addr
1bb0: 20 31 32 20 2b 20 62 65 2d 75 6c 40 20 75 6c 69 12 + be-ul@ uli
1bc0: 74 2c 20 61 64 64 72 2d 69 70 76 34 0a 09 09 45 t, addr-ipv4...E
1bd0: 4c 53 45 0a 09 09 20 20 20 20 61 64 64 72 20 73 LSE... addr s
1be0: 69 6e 36 5f 61 64 64 72 20 24 31 30 20 24 2c 20 in6_addr $10 $,
1bf0: 61 64 64 72 2d 69 70 76 36 0a 09 09 54 48 45 4e addr-ipv6...THEN
1c00: 0a 09 20 20 20 20 65 6e 64 6f 66 0a 09 65 6e 64 .. endof..end
1c10: 63 61 73 65 0a 09 61 64 64 72 20 70 6f 72 74 20 case..addr port
1c20: 62 65 2d 75 77 40 20 75 6c 69 74 2c 20 61 64 64 be-uw@ ulit, add
1c30: 72 2d 70 6f 72 74 0a 20 20 20 20 3b 5d 20 67 65 r-port. ;] ge
1c40: 6e 2d 63 6d 64 24 20 3b 0a 3a 20 73 6f 63 6b 61 n-cmd$ ;.: socka
1c50: 64 64 72 2b 72 65 74 75 72 6e 20 28 20 61 64 64 ddr+return ( add
1c60: 72 20 6c 65 6e 20 2d 2d 20 61 64 64 72 27 20 6c r len -- addr' l
1c70: 65 6e 27 20 29 0a 20 20 20 20 5b 3a 20 63 6d 64 en' ). [: cmd
1c80: 24 20 24 21 20 72 65 74 75 72 6e 2d 61 64 64 72 $ $! return-addr
1c90: 65 73 73 20 24 31 30 20 30 20 2d 73 6b 69 70 20 ess $10 0 -skip
1ca0: 24 2c 20 61 64 64 72 2d 72 6f 75 74 65 20 3b 5d $, addr-route ;]
1cb0: 20 67 65 6e 2d 63 6d 64 24 20 3b 0a 70 72 65 76 gen-cmd$ ;.prev
1cc0: 69 6f 75 73 0a 3a 20 3e 73 6f 63 6b 61 64 64 72 ious.: >sockaddr
1cd0: 20 28 20 2d 2d 20 61 64 64 72 20 6c 65 6e 20 29 ( -- addr len )
1ce0: 0a 20 20 20 20 72 65 74 75 72 6e 2d 61 64 64 72 . return-addr
1cf0: 65 73 73 20 62 65 40 20 72 6f 75 74 65 73 23 20 ess be@ routes#
1d00: 23 2e 6b 65 79 20 24 40 20 2e 73 6f 63 6b 61 64 #.key $@ .sockad
1d10: 64 72 20 3b 0a 0a 30 20 5b 49 46 5d 0a 4c 6f 63 dr ;..0 [IF].Loc
1d20: 61 6c 20 56 61 72 69 61 62 6c 65 73 3a 0a 66 6f al Variables:.fo
1d30: 72 74 68 2d 6c 6f 63 61 6c 2d 77 6f 72 64 73 3a rth-local-words:
1d40: 0a 20 20 20 20 28 0a 20 20 20 20 20 28 28 22 6e . (. (("n
1d50: 65 74 32 6f 3a 22 20 22 2b 6e 65 74 32 6f 3a 22 et2o:" "+net2o:"
1d60: 29 20 64 65 66 69 6e 69 74 69 6f 6e 2d 73 74 61 ) definition-sta
1d70: 72 74 65 72 20 28 66 6f 6e 74 2d 6c 6f 63 6b 2d rter (font-lock-
1d80: 6b 65 79 77 6f 72 64 2d 66 61 63 65 20 2e 20 31 keyword-face . 1
1d90: 29 0a 20 20 20 20 20 20 22 5b 20 5c 74 5c 6e 5d ). "[ \t\n]
1da0: 22 20 74 20 6e 61 6d 65 20 28 66 6f 6e 74 2d 6c " t name (font-l
1db0: 6f 63 6b 2d 66 75 6e 63 74 69 6f 6e 2d 6e 61 6d ock-function-nam
1dc0: 65 2d 66 61 63 65 20 2e 20 33 29 29 0a 20 20 20 e-face . 3)).
1dd0: 20 20 28 22 5b 61 2d 7a 30 2d 39 5d 2b 28 22 20 ("[a-z0-9]+("
1de0: 69 6d 6d 65 64 69 61 74 65 20 28 66 6f 6e 74 2d immediate (font-
1df0: 6c 6f 63 6b 2d 63 6f 6d 6d 65 6e 74 2d 66 61 63 lock-comment-fac
1e00: 65 20 2e 20 31 29 0a 20 20 20 20 20 20 22 29 22 e . 1). ")"
1e10: 20 6e 69 6c 20 63 6f 6d 6d 65 6e 74 20 28 66 6f nil comment (fo
1e20: 6e 74 2d 6c 6f 63 6b 2d 63 6f 6d 6d 65 6e 74 2d nt-lock-comment-
1e30: 66 61 63 65 20 2e 20 31 29 29 0a 20 20 20 20 29 face . 1)). )
1e40: 0a 66 6f 72 74 68 2d 6c 6f 63 61 6c 2d 69 6e 64 .forth-local-ind
1e50: 65 6e 74 2d 77 6f 72 64 73 3a 0a 20 20 20 20 28 ent-words:. (
1e60: 0a 20 20 20 20 20 28 28 22 6e 65 74 32 6f 3a 22 . (("net2o:"
1e70: 20 22 2b 6e 65 74 32 6f 3a 22 29 20 28 30 20 2e "+net2o:") (0 .
1e80: 20 32 29 20 28 30 20 2e 20 32 29 20 6e 6f 6e 2d 2) (0 . 2) non-
1e90: 69 6d 6d 65 64 69 61 74 65 29 0a 20 20 20 20 29 immediate). )
1ea0: 0a 45 6e 64 3a 0a 5b 54 48 45 4e 5d 0a .End:.[THEN].