Artifact
ca028cff798ac592622e281c971aa8714ccbc148:
- File
net2o-addr.fs
— part of check-in
[d021999a45]
at
2018-03-13 23:37:15
on branch trunk
— Tie secret key to routes
(user:
bernd
size: 7836)
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 3a 20 6e 32 6f 3a 6e 65 77 2d 61 64 64 e..: n2o:new-add
0740: 72 20 28 20 2d 2d 20 6f 20 29 0a 20 20 20 20 61 r ( -- o ). a
0750: 64 64 72 65 73 73 2d 63 6c 61 73 73 20 6e 65 77 ddress-class new
0760: 20 3e 6f 20 20 61 64 64 72 65 73 73 2d 74 61 62 >o address-tab
0770: 6c 65 20 40 20 74 6f 6b 65 6e 2d 74 61 62 6c 65 le @ token-table
0780: 20 21 20 6f 20 6f 3e 20 3b 0a 3a 20 6e 32 6f 3a ! o o> ;.: n2o:
0790: 64 69 73 70 6f 73 65 2d 61 64 64 72 20 28 20 6f dispose-addr ( o
07a0: 3a 61 64 64 72 20 2d 2d 20 6f 3a 61 64 64 72 20 :addr -- o:addr
07b0: 29 0a 20 20 20 20 68 6f 73 74 2d 69 64 20 24 6f ). host-id $o
07c0: 66 66 20 68 6f 73 74 2d 61 6e 63 68 6f 72 20 24 ff host-anchor $
07d0: 6f 66 66 20 68 6f 73 74 2d 72 6f 75 74 65 20 24 off host-route $
07e0: 6f 66 66 20 68 6f 73 74 2d 6b 65 79 20 73 65 63 off host-key sec
07f0: 2d 6f 66 66 0a 20 20 20 20 68 6f 73 74 2d 72 65 -off. host-re
0800: 76 6f 6b 65 20 24 6f 66 66 20 3b 0a 3a 20 6e 32 voke $off ;.: n2
0810: 6f 3a 64 69 73 70 6f 73 65 2d 70 75 6e 63 68 73 o:dispose-punchs
0820: 20 28 20 2d 2d 20 29 0a 20 20 20 20 70 75 6e 63 ( -- ). punc
0830: 68 2d 61 64 64 72 73 20 24 40 20 62 6f 75 6e 64 h-addrs $@ bound
0840: 73 20 3f 44 4f 20 20 49 20 40 20 2e 6e 32 6f 3a s ?DO I @ .n2o:
0850: 64 69 73 70 6f 73 65 2d 61 64 64 72 20 20 63 65 dispose-addr ce
0860: 6c 6c 20 2b 4c 4f 4f 50 0a 20 20 20 20 70 75 6e ll +LOOP. pun
0870: 63 68 2d 61 64 64 72 73 20 24 6f 66 66 20 3b 0a ch-addrs $off ;.
0880: 3a 6e 6f 6e 61 6d 65 20 28 20 2d 2d 20 29 0a 20 :noname ( -- ).
0890: 20 20 20 6e 32 6f 3a 64 69 73 70 6f 73 65 2d 70 n2o:dispose-p
08a0: 75 6e 63 68 73 20 20 64 65 66 65 72 73 20 65 78 unchs defers ex
08b0: 74 72 61 2d 64 69 73 70 6f 73 65 20 3b 20 69 73 tra-dispose ; is
08c0: 20 65 78 74 72 61 2d 64 69 73 70 6f 73 65 0a 0a extra-dispose..
08d0: 3a 20 6e 65 77 2d 61 64 64 72 20 28 20 61 64 64 : new-addr ( add
08e0: 72 20 75 20 2d 2d 20 6f 20 29 20 5c 47 20 63 72 r u -- o ) \G cr
08f0: 65 61 74 65 20 61 20 6e 65 77 20 61 64 64 72 65 eate a new addre
0900: 73 73 20 6f 62 6a 65 63 74 20 66 72 6f 6d 20 73 ss object from s
0910: 74 72 69 6e 67 0a 20 20 20 20 6e 32 6f 3a 6e 65 tring. n2o:ne
0920: 77 2d 61 64 64 72 20 6e 3a 3e 6f 20 6e 65 73 74 w-addr n:>o nest
0930: 2d 63 6d 64 2d 6c 6f 6f 70 20 6f 20 6e 3a 6f 3e -cmd-loop o n:o>
0940: 20 3b 0a 0a 61 6c 73 6f 20 6e 65 74 32 6f 2d 62 ;..also net2o-b
0950: 61 73 65 0a 3a 20 6f 2d 67 65 6e 61 64 64 72 20 ase.: o-genaddr
0960: 28 20 6f 20 2d 2d 20 29 20 3e 6f 20 5c 47 20 63 ( o -- ) >o \G c
0970: 72 65 61 74 65 20 6e 65 77 20 61 64 64 72 65 73 reate new addres
0980: 73 20 73 74 72 69 6e 67 20 66 72 6f 6d 20 6f 62 s string from ob
0990: 6a 65 63 74 0a 20 20 20 20 68 6f 73 74 2d 70 72 ject. host-pr
09a0: 69 23 20 40 20 75 6c 69 74 2c 20 61 64 64 72 2d i# @ ulit, addr-
09b0: 70 72 69 23 0a 20 20 20 20 68 6f 73 74 2d 69 64 pri#. host-id
09c0: 20 24 40 20 64 75 70 20 49 46 20 24 2c 20 61 64 $@ dup IF $, ad
09d0: 64 72 2d 69 64 20 20 45 4c 53 45 20 20 32 64 72 dr-id ELSE 2dr
09e0: 6f 70 20 20 54 48 45 4e 0a 20 20 20 20 68 6f 73 op THEN. hos
09f0: 74 2d 61 6e 63 68 6f 72 20 24 40 20 64 75 70 20 t-anchor $@ dup
0a00: 49 46 20 24 2c 20 61 64 64 72 2d 61 6e 63 68 6f IF $, addr-ancho
0a10: 72 20 20 45 4c 53 45 20 20 32 64 72 6f 70 20 20 r ELSE 2drop
0a20: 54 48 45 4e 0a 20 20 20 20 68 6f 73 74 2d 69 70 THEN. host-ip
0a30: 76 34 20 62 65 2d 75 6c 40 20 3f 64 75 70 2d 49 v4 be-ul@ ?dup-I
0a40: 46 20 75 6c 69 74 2c 20 61 64 64 72 2d 69 70 76 F ulit, addr-ipv
0a50: 34 20 20 54 48 45 4e 0a 20 20 20 20 68 6f 73 74 4 THEN. host
0a60: 2d 69 70 76 36 20 69 70 36 3f 20 49 46 20 20 68 -ipv6 ip6? IF h
0a70: 6f 73 74 2d 69 70 76 36 20 24 31 30 20 24 2c 20 ost-ipv6 $10 $,
0a80: 61 64 64 72 2d 69 70 76 36 20 20 54 48 45 4e 0a addr-ipv6 THEN.
0a90: 20 20 20 20 68 6f 73 74 2d 70 6f 72 74 76 34 20 host-portv4
0aa0: 77 40 20 68 6f 73 74 2d 70 6f 72 74 76 36 20 77 w@ host-portv6 w
0ab0: 40 20 3d 20 49 46 0a 09 68 6f 73 74 2d 70 6f 72 @ = IF..host-por
0ac0: 74 76 34 20 77 40 20 75 6c 69 74 2c 20 61 64 64 tv4 w@ ulit, add
0ad0: 72 2d 70 6f 72 74 0a 20 20 20 20 45 4c 53 45 0a r-port. ELSE.
0ae0: 09 68 6f 73 74 2d 70 6f 72 74 76 34 20 77 40 20 .host-portv4 w@
0af0: 3f 64 75 70 2d 49 46 20 20 75 6c 69 74 2c 20 61 ?dup-IF ulit, a
0b00: 64 64 72 2d 70 6f 72 74 76 34 20 20 54 48 45 4e ddr-portv4 THEN
0b10: 0a 09 68 6f 73 74 2d 70 6f 72 74 76 36 20 77 40 ..host-portv6 w@
0b20: 20 3f 64 75 70 2d 49 46 20 20 75 6c 69 74 2c 20 ?dup-IF ulit,
0b30: 61 64 64 72 2d 70 6f 72 74 76 36 20 20 54 48 45 addr-portv6 THE
0b40: 4e 0a 20 20 20 20 54 48 45 4e 0a 20 20 20 20 68 N. THEN. h
0b50: 6f 73 74 2d 72 6f 75 74 65 20 24 40 20 64 75 70 ost-route $@ dup
0b60: 20 49 46 20 20 24 2c 20 61 64 64 72 2d 72 6f 75 IF $, addr-rou
0b70: 74 65 20 20 45 4c 53 45 20 20 32 64 72 6f 70 20 te ELSE 2drop
0b80: 20 54 48 45 4e 0a 20 20 20 20 68 6f 73 74 2d 6b THEN. host-k
0b90: 65 79 20 73 65 63 40 20 64 75 70 20 49 46 20 20 ey sec@ dup IF
0ba0: 73 65 63 24 2c 20 61 64 64 72 2d 6b 65 79 20 20 sec$, addr-key
0bb0: 45 4c 53 45 20 20 32 64 72 6f 70 20 20 54 48 45 ELSE 2drop THE
0bc0: 4e 0a 20 20 20 20 68 6f 73 74 2d 65 6b 65 79 20 N. host-ekey
0bd0: 24 40 20 64 75 70 20 49 46 20 20 24 2c 20 68 6f $@ dup IF $, ho
0be0: 73 74 2d 65 6b 65 79 2d 74 6f 20 36 34 40 20 75 st-ekey-to 64@ u
0bf0: 6c 69 74 2c 20 61 64 64 72 2d 65 6b 65 79 20 20 lit, addr-ekey
0c00: 45 4c 53 45 20 20 32 64 72 6f 70 20 20 54 48 45 ELSE 2drop THE
0c10: 4e 0a 20 20 20 20 68 6f 73 74 2d 72 65 76 6f 6b N. host-revok
0c20: 65 20 24 40 20 64 75 70 20 49 46 20 20 24 2c 20 e $@ dup IF $,
0c30: 61 64 64 72 2d 72 65 76 6f 6b 65 20 20 45 4c 53 addr-revoke ELS
0c40: 45 20 20 32 64 72 6f 70 20 20 54 48 45 4e 20 6f E 2drop THEN o
0c50: 3e 20 3b 20 0a 70 72 65 76 69 6f 75 73 0a 3a 20 > ; .previous.:
0c60: 6f 3e 61 64 64 72 20 28 20 6f 20 2d 2d 20 61 64 o>addr ( o -- ad
0c70: 64 72 20 75 20 29 0a 20 20 20 20 63 6d 64 62 75 dr u ). cmdbu
0c80: 66 2d 6f 20 40 20 3e 72 20 63 6f 64 65 2d 62 75 f-o @ >r code-bu
0c90: 66 24 20 63 6d 64 72 65 73 65 74 20 6f 2d 67 65 f$ cmdreset o-ge
0ca0: 6e 61 64 64 72 20 63 6d 64 62 75 66 24 20 72 3e naddr cmdbuf$ r>
0cb0: 20 63 6d 64 62 75 66 2d 6f 20 21 20 3b 0a 0a 3a cmdbuf-o ! ;..:
0cc0: 20 2e 61 64 64 72 20 28 20 6f 20 2d 2d 20 29 20 .addr ( o -- )
0cd0: 5c 47 20 70 72 69 6e 74 20 61 64 64 72 0a 20 20 \G print addr.
0ce0: 20 20 3e 6f 0a 20 20 20 20 68 6f 73 74 2d 70 72 >o. host-pr
0cf0: 69 23 20 40 20 3f 64 75 70 2d 49 46 20 20 30 20 i# @ ?dup-IF 0
0d00: 2e 72 20 27 23 27 20 65 6d 69 74 20 20 54 48 45 .r '#' emit THE
0d10: 4e 0a 20 20 20 20 68 6f 73 74 2d 69 64 20 24 40 N. host-id $@
0d20: 20 64 75 70 20 49 46 20 27 22 27 20 65 6d 69 74 dup IF '"' emit
0d30: 20 74 79 70 65 20 27 22 27 20 65 6d 69 74 20 20 type '"' emit
0d40: 45 4c 53 45 20 20 32 64 72 6f 70 20 20 54 48 45 ELSE 2drop THE
0d50: 4e 0a 20 20 20 20 68 6f 73 74 2d 61 6e 63 68 6f N. host-ancho
0d60: 72 20 24 40 20 64 75 70 20 49 46 20 2e 22 20 61 r $@ dup IF ." a
0d70: 6e 63 68 6f 72 3a 20 22 20 38 35 74 79 70 65 20 nchor: " 85type
0d80: 63 72 20 20 45 4c 53 45 20 20 32 64 72 6f 70 20 cr ELSE 2drop
0d90: 20 54 48 45 4e 0a 20 20 20 20 68 6f 73 74 2d 69 THEN. host-i
0da0: 70 76 36 20 69 70 36 3f 20 49 46 20 20 68 6f 73 pv6 ip6? IF hos
0db0: 74 2d 69 70 76 36 20 24 31 30 20 2e 69 70 36 61 t-ipv6 $10 .ip6a
0dc0: 20 32 64 72 6f 70 0a 09 68 6f 73 74 2d 70 6f 72 2drop..host-por
0dd0: 74 76 34 20 77 40 20 68 6f 73 74 2d 70 6f 72 74 tv4 w@ host-port
0de0: 76 36 20 77 40 20 3c 3e 20 49 46 20 20 68 6f 73 v6 w@ <> IF hos
0df0: 74 2d 70 6f 72 74 76 36 20 77 40 20 2e 22 20 3a t-portv6 w@ ." :
0e00: 22 20 30 20 2e 72 20 73 70 61 63 65 20 54 48 45 " 0 .r space THE
0e10: 4e 0a 20 20 20 20 54 48 45 4e 0a 20 20 20 20 68 N. THEN. h
0e20: 6f 73 74 2d 69 70 76 34 20 62 65 2d 75 6c 40 20 ost-ipv4 be-ul@
0e30: 64 75 70 20 49 46 20 68 6f 73 74 2d 69 70 76 34 dup IF host-ipv4
0e40: 20 34 20 2e 69 70 34 61 20 32 64 72 6f 70 20 20 4 .ip4a 2drop
0e50: 54 48 45 4e 0a 20 20 20 20 68 6f 73 74 2d 70 6f THEN. host-po
0e60: 72 74 76 34 20 77 40 20 68 6f 73 74 2d 70 6f 72 rtv4 w@ host-por
0e70: 74 76 36 20 77 40 20 3d 20 6f 72 20 20 49 46 20 tv6 w@ = or IF
0e80: 68 6f 73 74 2d 70 6f 72 74 76 34 20 77 40 20 2e host-portv4 w@ .
0e90: 22 20 3a 22 20 30 20 2e 72 20 20 54 48 45 4e 0a " :" 0 .r THEN.
0ea0: 20 20 20 20 68 6f 73 74 2d 72 6f 75 74 65 20 24 host-route $
0eb0: 40 20 64 75 70 20 49 46 20 20 27 7c 27 20 65 6d @ dup IF '|' em
0ec0: 69 74 20 78 74 79 70 65 20 20 45 4c 53 45 20 20 it xtype ELSE
0ed0: 32 64 72 6f 70 20 20 54 48 45 4e 0a 20 20 20 20 2drop THEN.
0ee0: 68 6f 73 74 2d 6b 65 79 20 73 65 63 40 20 64 75 host-key sec@ du
0ef0: 70 20 49 46 20 20 27 24 27 20 65 6d 69 74 20 2e p IF '$' emit .
0f00: 62 6c 61 63 6b 38 35 20 20 45 4c 53 45 20 20 32 black85 ELSE 2
0f10: 64 72 6f 70 20 20 54 48 45 4e 0a 20 20 20 20 6f drop THEN. o
0f20: 3e 20 3b 20 0a 0a 3a 20 2e 6e 61 74 2d 61 64 64 > ; ..: .nat-add
0f30: 72 73 20 28 20 2d 2d 20 29 0a 20 20 20 20 70 75 rs ( -- ). pu
0f40: 6e 63 68 2d 61 64 64 72 73 20 24 40 20 62 6f 75 nch-addrs $@ bou
0f50: 6e 64 73 20 3f 44 4f 20 20 49 20 40 20 2e 61 64 nds ?DO I @ .ad
0f60: 64 72 20 63 72 20 20 63 65 6c 6c 20 2b 4c 4f 4f dr cr cell +LOO
0f70: 50 20 3b 0a 0a 3a 20 2e 61 64 64 72 24 20 28 20 P ;..: .addr$ (
0f80: 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 addr u -- ).
0f90: 6e 65 77 2d 61 64 64 72 20 3e 6f 20 6f 20 2e 61 new-addr >o o .a
0fa0: 64 64 72 20 6e 32 6f 3a 64 69 73 70 6f 73 65 2d ddr n2o:dispose-
0fb0: 61 64 64 72 20 6f 3e 20 3b 0a 0a 55 73 65 72 20 addr o> ;..User
0fc0: 64 65 73 74 2d 30 6b 65 79 3e 20 5c 20 70 6f 69 dest-0key> \ poi
0fd0: 6e 74 65 72 20 74 6f 20 64 65 73 74 2d 30 6b 65 nter to dest-0ke
0fe0: 79 0a 55 73 65 72 20 64 65 73 74 2d 30 6b 65 79 y.User dest-0key
0ff0: 3c 20 5c 20 70 6f 69 6e 74 65 72 20 74 6f 20 6f < \ pointer to o
1000: 62 74 61 69 6e 65 64 20 64 65 73 74 2d 30 6b 65 btained dest-0ke
1010: 79 0a 0a 3a 20 61 64 64 72 3e 36 73 6f 63 6b 20 y..: addr>6sock
1020: 28 20 2d 2d 20 29 0a 20 20 20 20 68 6f 73 74 2d ( -- ). host-
1030: 6b 65 79 20 73 65 63 40 20 64 65 73 74 2d 30 6b key sec@ dest-0k
1040: 65 79 3c 20 73 65 63 21 0a 20 20 20 20 68 6f 73 ey< sec!. hos
1050: 74 2d 70 6f 72 74 76 36 20 77 40 20 73 6f 63 6b t-portv6 w@ sock
1060: 61 64 64 72 31 20 70 6f 72 74 20 62 65 2d 77 21 addr1 port be-w!
1070: 0a 20 20 20 20 68 6f 73 74 2d 69 70 76 36 20 73 . host-ipv6 s
1080: 6f 63 6b 61 64 64 72 31 20 73 69 6e 36 5f 61 64 ockaddr1 sin6_ad
1090: 64 72 20 69 70 36 21 0a 20 20 20 20 68 6f 73 74 dr ip6!. host
10a0: 2d 72 6f 75 74 65 20 24 40 20 21 74 65 6d 70 2d -route $@ !temp-
10b0: 61 64 64 72 20 3b 0a 0a 3a 20 61 64 64 72 3e 34 addr ;..: addr>4
10c0: 73 6f 63 6b 20 28 20 2d 2d 20 29 0a 20 20 20 20 sock ( -- ).
10d0: 68 6f 73 74 2d 6b 65 79 20 73 65 63 40 20 64 65 host-key sec@ de
10e0: 73 74 2d 30 6b 65 79 3c 20 73 65 63 21 0a 20 20 st-0key< sec!.
10f0: 20 20 68 6f 73 74 2d 70 6f 72 74 76 34 20 77 40 host-portv4 w@
1100: 20 73 6f 63 6b 61 64 64 72 31 20 70 6f 72 74 20 sockaddr1 port
1110: 62 65 2d 77 21 0a 20 20 20 20 68 6f 73 74 2d 69 be-w!. host-i
1120: 70 76 34 20 62 65 2d 75 6c 40 20 73 6f 63 6b 61 pv4 be-ul@ socka
1130: 64 64 72 31 20 69 70 76 34 21 0a 20 20 20 20 68 ddr1 ipv4!. h
1140: 6f 73 74 2d 72 6f 75 74 65 20 24 40 20 21 74 65 ost-route $@ !te
1150: 6d 70 2d 61 64 64 72 20 3b 0a 0a 3a 6e 6f 6e 61 mp-addr ;..:nona
1160: 6d 65 20 28 20 6f 20 78 74 20 2d 2d 20 29 20 7b me ( o xt -- ) {
1170: 20 78 74 20 7d 20 3e 6f 0a 20 20 20 20 69 70 76 xt } >o. ipv
1180: 34 28 20 68 6f 73 74 2d 69 70 76 34 20 62 65 2d 4( host-ipv4 be-
1190: 75 6c 40 20 49 46 20 20 61 64 64 72 3e 34 73 6f ul@ IF addr>4so
11a0: 63 6b 20 6f 20 6f 3e 20 3e 72 20 78 74 20 65 78 ck o o> >r xt ex
11b0: 65 63 75 74 65 20 20 72 3e 20 3e 6f 20 54 48 45 ecute r> >o THE
11c0: 4e 20 29 0a 20 20 20 20 69 70 76 36 28 20 68 6f N ). ipv6( ho
11d0: 73 74 2d 69 70 76 36 20 69 70 36 3f 20 20 20 49 st-ipv6 ip6? I
11e0: 46 20 20 61 64 64 72 3e 36 73 6f 63 6b 20 6f 20 F addr>6sock o
11f0: 6f 3e 20 3e 72 20 78 74 20 65 78 65 63 75 74 65 o> >r xt execute
1200: 20 20 72 3e 20 3e 6f 20 54 48 45 4e 20 29 0a 20 r> >o THEN ).
1210: 20 20 20 6f 3e 20 3b 20 69 73 20 61 64 64 72 3e o> ; is addr>
1220: 73 6f 63 6b 0a 0a 3a 20 2b 6d 79 2d 69 64 20 28 sock..: +my-id (
1230: 20 2d 2d 20 29 0a 20 20 20 20 63 6f 6e 66 69 67 -- ). config
1240: 3a 70 72 69 6f 23 20 40 20 68 6f 73 74 2d 70 72 :prio# @ host-pr
1250: 69 23 20 21 0a 20 20 20 20 68 6f 73 74 24 20 24 i# !. host$ $
1260: 40 20 68 6f 73 74 2d 69 64 20 24 21 0a 20 20 20 @ host-id $!.
1270: 20 6d 79 2d 30 6b 65 79 20 40 20 49 46 20 20 6d my-0key @ IF m
1280: 79 2d 30 6b 65 79 20 73 65 63 40 20 68 6f 73 74 y-0key sec@ host
1290: 2d 6b 65 79 20 73 65 63 21 20 20 54 48 45 4e 20 -key sec! THEN
12a0: 3b 0a 0a 3a 20 2b 6d 79 2d 61 64 64 72 73 20 28 ;..: +my-addrs (
12b0: 20 70 6f 72 74 20 6f 3a 61 64 64 72 20 2d 2d 20 port o:addr --
12c0: 29 0a 20 20 20 20 2b 6d 79 2d 69 64 0a 20 20 20 ). +my-id.
12d0: 20 64 75 70 20 68 6f 73 74 2d 70 6f 72 74 76 34 dup host-portv4
12e0: 20 77 21 20 20 68 6f 73 74 2d 70 6f 72 74 76 36 w! host-portv6
12f0: 20 77 21 0a 20 20 20 20 6f 20 6d 79 2d 61 64 64 w!. o my-add
1300: 72 5b 5d 20 24 5b 5d 23 20 6d 79 2d 61 64 64 72 r[] $[]# my-addr
1310: 5b 5d 20 24 5b 5d 20 21 20 3b 0a 0a 3a 20 21 6d [] $[] ! ;..: !m
1320: 79 2d 61 64 64 72 73 20 28 20 2d 2d 20 29 20 6e y-addrs ( -- ) n
1330: 32 6f 3a 6e 65 77 2d 61 64 64 72 20 3e 6f 0a 20 2o:new-addr >o.
1340: 20 20 20 67 6c 6f 62 61 6c 2d 69 70 36 20 74 75 global-ip6 tu
1350: 63 6b 20 68 6f 73 74 2d 69 70 76 36 20 24 31 30 ck host-ipv6 $10
1360: 20 73 6d 6f 76 65 0a 20 20 20 20 67 6c 6f 62 61 smove. globa
1370: 6c 2d 69 70 34 20 49 46 20 20 62 65 2d 75 6c 40 l-ip4 IF be-ul@
1380: 20 68 6f 73 74 2d 69 70 76 34 20 62 65 2d 6c 21 host-ipv4 be-l!
1390: 20 20 45 4c 53 45 20 20 64 72 6f 70 20 20 54 48 ELSE drop TH
13a0: 45 4e 0a 20 20 20 20 6d 79 2d 70 6f 72 74 23 20 EN. my-port#
13b0: 2b 6d 79 2d 61 64 64 72 73 20 6f 3e 0a 20 20 20 +my-addrs o>.
13c0: 20 30 3d 20 49 46 20 20 69 70 76 36 28 20 6c 6f 0= IF ipv6( lo
13d0: 63 61 6c 2d 69 70 36 20 20 49 46 0a 09 20 20 20 cal-ip6 IF..
13e0: 20 6e 32 6f 3a 6e 65 77 2d 61 64 64 72 20 3e 6f n2o:new-addr >o
13f0: 20 20 68 6f 73 74 2d 69 70 76 36 20 69 70 36 21 host-ipv6 ip6!
1400: 20 20 6d 79 2d 70 6f 72 74 23 20 2b 6d 79 2d 61 my-port# +my-a
1410: 64 64 72 73 20 20 6f 3e 0a 09 45 4c 53 45 20 20 ddrs o>..ELSE
1420: 64 72 6f 70 20 20 54 48 45 4e 20 29 0a 20 20 20 drop THEN ).
1430: 20 54 48 45 4e 20 3b 0a 0a 3a 20 24 5b 5d 6f 2d THEN ;..: $[]o-
1440: 6d 61 70 20 7b 20 61 64 64 72 20 78 74 20 2d 2d map { addr xt --
1450: 20 7d 0a 20 20 20 20 5c 47 20 65 78 65 63 75 74 }. \G execut
1460: 65 20 40 76 61 72 7b 78 74 7d 20 66 6f 72 20 61 e @var{xt} for a
1470: 6c 6c 20 65 6c 65 6d 65 6e 74 73 20 6f 66 20 74 ll elements of t
1480: 68 65 20 6f 62 6a 65 63 74 20 61 72 72 61 79 20 he object array
1490: 40 76 61 72 7b 61 64 64 72 7d 2e 0a 20 20 20 20 @var{addr}..
14a0: 5c 47 20 78 74 20 69 73 20 40 76 61 72 7b 28 20 \G xt is @var{(
14b0: 6f 20 2d 2d 20 29 7d 2c 20 67 65 74 74 69 6e 67 o -- )}, getting
14c0: 20 6f 6e 65 20 73 74 72 69 6e 67 20 61 74 20 61 one string at a
14d0: 20 74 69 6d 65 0a 20 20 20 20 61 64 64 72 20 24 time. addr $
14e0: 5b 5d 23 20 30 20 3f 44 4f 20 20 49 20 61 64 64 []# 0 ?DO I add
14f0: 72 20 24 5b 5d 20 40 20 78 74 20 65 78 65 63 75 r $[] @ xt execu
1500: 74 65 20 20 4c 4f 4f 50 20 3b 0a 0a 3a 20 61 64 te LOOP ;..: ad
1510: 64 72 73 2d 6f 66 66 20 28 20 2d 2d 20 29 0a 20 drs-off ( -- ).
1520: 20 20 20 5c 47 20 64 69 73 70 6f 73 65 20 61 6c \G dispose al
1530: 6c 20 61 64 64 72 65 73 73 65 73 0a 20 20 20 20 l addresses.
1540: 6d 79 2d 61 64 64 72 5b 5d 20 5b 3a 20 2e 6e 32 my-addr[] [: .n2
1550: 6f 3a 64 69 73 70 6f 73 65 2d 61 64 64 72 20 3b o:dispose-addr ;
1560: 5d 20 24 5b 5d 6f 2d 6d 61 70 0a 20 20 20 20 6d ] $[]o-map. m
1570: 79 2d 61 64 64 72 5b 5d 20 24 6f 66 66 0a 20 20 y-addr[] $off.
1580: 20 20 6d 79 2d 61 64 64 72 24 20 24 5b 5d 6f 66 my-addr$ $[]of
1590: 66 0a 20 20 20 20 70 75 62 2d 61 64 64 72 24 20 f. pub-addr$
15a0: 24 5b 5d 6f 66 66 0a 20 20 20 20 70 72 69 76 2d $[]off. priv-
15b0: 61 64 64 72 24 20 24 5b 5d 6f 66 66 20 3b 0a 0a addr$ $[]off ;..
15c0: 3a 20 21 6d 79 2d 61 64 64 72 24 20 28 20 2d 2d : !my-addr$ ( --
15d0: 20 29 0a 20 20 20 20 6d 79 2d 6b 65 79 2d 64 65 ). my-key-de
15e0: 66 61 75 6c 74 20 30 3d 20 3f 45 58 49 54 0a 20 fault 0= ?EXIT.
15f0: 20 20 20 6e 6f 77 3e 6e 65 76 65 72 20 20 6d 79 now>never my
1600: 2d 61 64 64 72 5b 5d 20 5b 3a 0a 20 20 20 20 20 -addr[] [:.
1610: 20 6e 61 74 28 20 2e 22 20 69 6e 73 65 72 74 20 nat( ." insert
1620: 69 6e 74 6f 20 6d 79 2d 61 64 64 72 24 3a 20 22 into my-addr$: "
1630: 20 64 75 70 20 2e 61 64 64 72 20 66 6f 72 74 68 dup .addr forth
1640: 3a 63 72 20 29 0a 20 20 20 20 20 20 6f 3e 61 64 :cr ). o>ad
1650: 64 72 20 67 65 6e 2d 68 6f 73 74 20 6d 79 2d 61 dr gen-host my-a
1660: 64 64 72 24 20 24 69 6e 73 5b 5d 73 69 67 20 64 ddr$ $ins[]sig d
1670: 72 6f 70 20 3b 5d 20 24 5b 5d 6f 2d 6d 61 70 20 rop ;] $[]o-map
1680: 3b 0a 0a 3a 20 2e 6d 79 2d 61 64 64 72 73 20 28 ;..: .my-addrs (
1690: 20 2d 2d 20 29 0a 20 20 20 20 6d 79 2d 61 64 64 -- ). my-add
16a0: 72 5b 5d 20 5b 3a 20 2e 61 64 64 72 20 63 72 20 r[] [: .addr cr
16b0: 3b 5d 20 24 5b 5d 6f 2d 6d 61 70 20 3b 0a 3a 20 ;] $[]o-map ;.:
16c0: 2e 6d 79 2d 61 64 64 72 24 73 20 28 20 2d 2d 20 .my-addr$s ( --
16d0: 29 0a 20 20 20 20 6d 79 2d 61 64 64 72 24 20 5b ). my-addr$ [
16e0: 3a 20 73 69 67 73 69 7a 65 23 20 2d 20 2e 61 64 : sigsize# - .ad
16f0: 64 72 24 20 63 72 20 3b 5d 20 24 5b 5d 6d 61 70 dr$ cr ;] $[]map
1700: 20 3b 0a 3a 20 2e 70 75 62 2d 61 64 64 72 24 73 ;.: .pub-addr$s
1710: 20 28 20 2d 2d 20 29 0a 20 20 20 20 70 75 62 2d ( -- ). pub-
1720: 61 64 64 72 24 20 5b 3a 20 73 69 67 73 69 7a 65 addr$ [: sigsize
1730: 23 20 2d 20 2e 61 64 64 72 24 20 63 72 20 3b 5d # - .addr$ cr ;]
1740: 20 24 5b 5d 6d 61 70 20 3b 0a 3a 20 2e 70 72 69 $[]map ;.: .pri
1750: 76 2d 61 64 64 72 24 73 20 28 20 2d 2d 20 29 0a v-addr$s ( -- ).
1760: 20 20 20 20 70 72 69 76 2d 61 64 64 72 24 20 5b priv-addr$ [
1770: 3a 20 73 69 67 73 69 7a 65 23 20 2d 20 2e 61 64 : sigsize# - .ad
1780: 64 72 24 20 63 72 20 3b 5d 20 24 5b 5d 6d 61 70 dr$ cr ;] $[]map
1790: 20 3b 0a 0a 3a 20 21 6d 79 2d 61 64 64 72 20 28 ;..: !my-addr (
17a0: 20 2d 2d 20 29 20 61 64 64 72 73 2d 6f 66 66 20 -- ) addrs-off
17b0: 21 6d 79 2d 61 64 64 72 73 20 21 6d 79 2d 61 64 !my-addrs !my-ad
17c0: 64 72 24 20 3b 0a 0a 5c 20 6d 65 72 67 65 20 61 dr$ ;..\ merge a
17d0: 64 64 72 65 73 73 65 73 0a 0a 3a 20 6d 79 2d 61 ddresses..: my-a
17e0: 64 64 72 3d 20 28 20 6f 31 20 6f 3a 6f 32 20 2d ddr= ( o1 o:o2 -
17f0: 2d 20 29 20 7b 20 6f 31 20 7d 0a 20 20 20 20 6f - ) { o1 }. o
1800: 31 20 2e 68 6f 73 74 2d 70 6f 72 74 76 34 20 32 1 .host-portv4 2
1810: 20 68 6f 73 74 2d 70 6f 72 74 76 34 20 6f 76 65 host-portv4 ove
1820: 72 20 73 74 72 3d 3f 30 20 26 26 0a 20 20 20 20 r str=?0 &&.
1830: 6f 31 20 2e 68 6f 73 74 2d 70 6f 72 74 76 36 20 o1 .host-portv6
1840: 32 20 68 6f 73 74 2d 70 6f 72 74 76 36 20 6f 76 2 host-portv6 ov
1850: 65 72 20 73 74 72 3d 3f 30 20 26 26 0a 20 20 20 er str=?0 &&.
1860: 20 6f 31 20 2e 68 6f 73 74 2d 72 6f 75 74 65 20 o1 .host-route
1870: 24 40 20 68 6f 73 74 2d 72 6f 75 74 65 20 24 40 $@ host-route $@
1880: 20 20 73 74 72 3d 3f 30 20 26 26 0a 20 20 20 20 str=?0 &&.
1890: 6f 31 20 2e 68 6f 73 74 2d 69 70 76 34 20 20 20 o1 .host-ipv4
18a0: 34 20 68 6f 73 74 2d 69 70 76 34 20 6f 76 65 72 4 host-ipv4 over
18b0: 20 73 74 72 3d 3f 30 20 26 26 0a 20 20 20 20 6f str=?0 &&. o
18c0: 31 20 2e 68 6f 73 74 2d 69 70 76 36 20 24 31 30 1 .host-ipv6 $10
18d0: 20 68 6f 73 74 2d 69 70 76 36 20 6f 76 65 72 20 host-ipv6 over
18e0: 73 74 72 3d 3f 30 20 3b 0a 0a 3a 20 6d 79 2d 61 str=?0 ;..: my-a
18f0: 64 64 72 3f 20 28 20 6f 20 2d 2d 20 66 6c 61 67 ddr? ( o -- flag
1900: 20 29 0a 20 20 20 20 66 61 6c 73 65 20 6d 79 2d ). false my-
1910: 61 64 64 72 5b 5d 20 5b 3a 20 3e 6f 20 6f 76 65 addr[] [: >o ove
1920: 72 20 6d 79 2d 61 64 64 72 3d 20 6f 3e 20 6f 72 r my-addr= o> or
1930: 20 3b 5d 20 24 5b 5d 6f 2d 6d 61 70 20 6e 69 70 ;] $[]o-map nip
1940: 20 3b 0a 0a 3a 20 6d 79 2d 61 64 64 72 2d 6d 65 ;..: my-addr-me
1950: 72 67 65 31 20 28 20 6f 31 20 6f 3a 6f 32 20 2d rge1 ( o1 o:o2 -
1960: 2d 20 29 20 7b 20 6f 31 20 7d 0a 20 20 20 20 6f - ) { o1 }. o
1970: 31 20 2e 68 6f 73 74 2d 69 70 76 34 20 20 20 34 1 .host-ipv4 4
1980: 20 68 6f 73 74 2d 69 70 76 34 20 6f 76 65 72 20 host-ipv4 over
1990: 73 74 72 3e 6d 65 72 67 65 0a 20 20 20 20 6f 31 str>merge. o1
19a0: 20 2e 68 6f 73 74 2d 69 70 76 36 20 24 31 30 20 .host-ipv6 $10
19b0: 68 6f 73 74 2d 69 70 76 36 20 6f 76 65 72 20 73 host-ipv6 over s
19c0: 74 72 3e 6d 65 72 67 65 20 3b 0a 0a 3a 20 6d 79 tr>merge ;..: my
19d0: 2d 61 64 64 72 2d 6d 65 72 67 65 20 28 20 6f 20 -addr-merge ( o
19e0: 2d 2d 20 66 6c 61 67 20 29 0a 20 20 20 20 66 61 -- flag ). fa
19f0: 6c 73 65 20 73 77 61 70 0a 20 20 20 20 6d 79 2d lse swap. my-
1a00: 61 64 64 72 5b 5d 20 5b 3a 20 3e 6f 20 64 75 70 addr[] [: >o dup
1a10: 20 6d 79 2d 61 64 64 72 3d 20 49 46 20 64 75 70 my-addr= IF dup
1a20: 20 6d 79 2d 61 64 64 72 2d 6d 65 72 67 65 31 0a my-addr-merge1.
1a30: 09 6e 69 70 20 74 72 75 65 20 73 77 61 70 20 54 .nip true swap T
1a40: 48 45 4e 20 6f 3e 20 3b 5d 20 24 5b 5d 6f 2d 6d HEN o> ;] $[]o-m
1a50: 61 70 0a 20 20 20 20 64 72 6f 70 20 3b 0a 0a 5c ap. drop ;..\
1a60: 20 73 6f 63 6b 61 64 64 72 20 63 6f 6e 76 65 72 sockaddr conver
1a70: 73 69 6f 6e 0a 0a 61 6c 73 6f 20 6e 65 74 32 6f sion..also net2o
1a80: 2d 62 61 73 65 0a 3a 20 2e 73 6f 63 6b 61 64 64 -base.: .sockadd
1a90: 72 20 28 20 61 64 64 72 20 61 6c 65 6e 20 2d 2d r ( addr alen --
1aa0: 20 73 6f 63 6b 61 64 64 72 20 75 20 29 0a 20 20 sockaddr u ).
1ab0: 20 20 5c 20 63 6f 6e 76 65 72 74 20 73 6f 63 6b \ convert sock
1ac0: 65 74 20 69 6e 74 6f 20 6e 65 74 32 6f 20 61 64 et into net2o ad
1ad0: 64 72 65 73 73 20 74 6f 6b 65 6e 0a 20 20 20 20 dress token.
1ae0: 5b 3a 20 7b 20 61 64 64 72 20 61 6c 65 6e 20 7d [: { addr alen }
1af0: 0a 09 63 61 73 65 20 61 64 64 72 20 66 61 6d 69 ..case addr fami
1b00: 6c 79 20 77 40 0a 09 20 20 20 20 41 46 5f 49 4e ly w@.. AF_IN
1b10: 45 54 20 6f 66 0a 09 09 61 64 64 72 20 73 69 6e ET of...addr sin
1b20: 5f 61 64 64 72 20 62 65 2d 75 6c 40 20 75 6c 69 _addr be-ul@ uli
1b30: 74 2c 20 61 64 64 72 2d 69 70 76 34 0a 09 20 20 t, addr-ipv4..
1b40: 20 20 65 6e 64 6f 66 0a 09 20 20 20 20 41 46 5f endof.. AF_
1b50: 49 4e 45 54 36 20 6f 66 0a 09 09 61 64 64 72 20 INET6 of...addr
1b60: 73 69 6e 36 5f 61 64 64 72 20 31 32 20 66 61 6b sin6_addr 12 fak
1b70: 65 2d 69 70 34 20 6f 76 65 72 20 73 74 72 3d 20 e-ip4 over str=
1b80: 49 46 0a 09 09 20 20 20 20 2e 69 70 36 3a 3a 30 IF... .ip6::0
1b90: 20 61 64 64 72 20 73 69 6e 36 5f 61 64 64 72 20 addr sin6_addr
1ba0: 31 32 20 2b 20 62 65 2d 75 6c 40 20 75 6c 69 74 12 + be-ul@ ulit
1bb0: 2c 20 61 64 64 72 2d 69 70 76 34 0a 09 09 45 4c , addr-ipv4...EL
1bc0: 53 45 0a 09 09 20 20 20 20 61 64 64 72 20 73 69 SE... addr si
1bd0: 6e 36 5f 61 64 64 72 20 24 31 30 20 24 2c 20 61 n6_addr $10 $, a
1be0: 64 64 72 2d 69 70 76 36 0a 09 09 54 48 45 4e 0a ddr-ipv6...THEN.
1bf0: 09 20 20 20 20 65 6e 64 6f 66 0a 09 65 6e 64 63 . endof..endc
1c00: 61 73 65 0a 09 61 64 64 72 20 70 6f 72 74 20 62 ase..addr port b
1c10: 65 2d 75 77 40 20 75 6c 69 74 2c 20 61 64 64 72 e-uw@ ulit, addr
1c20: 2d 70 6f 72 74 0a 20 20 20 20 3b 5d 20 67 65 6e -port. ;] gen
1c30: 2d 63 6d 64 24 20 3b 0a 3a 20 73 6f 63 6b 61 64 -cmd$ ;.: sockad
1c40: 64 72 2b 72 65 74 75 72 6e 20 28 20 61 64 64 72 dr+return ( addr
1c50: 20 6c 65 6e 20 2d 2d 20 61 64 64 72 27 20 6c 65 len -- addr' le
1c60: 6e 27 20 29 0a 20 20 20 20 5b 3a 20 63 6d 64 24 n' ). [: cmd$
1c70: 20 24 21 20 72 65 74 75 72 6e 2d 61 64 64 72 65 $! return-addre
1c80: 73 73 20 24 31 30 20 30 20 2d 73 6b 69 70 20 24 ss $10 0 -skip $
1c90: 2c 20 61 64 64 72 2d 72 6f 75 74 65 20 3b 5d 20 , addr-route ;]
1ca0: 67 65 6e 2d 63 6d 64 24 20 3b 0a 70 72 65 76 69 gen-cmd$ ;.previ
1cb0: 6f 75 73 0a 3a 20 3e 73 6f 63 6b 61 64 64 72 20 ous.: >sockaddr
1cc0: 28 20 2d 2d 20 61 64 64 72 20 6c 65 6e 20 29 0a ( -- addr len ).
1cd0: 20 20 20 20 72 65 74 75 72 6e 2d 61 64 64 72 65 return-addre
1ce0: 73 73 20 62 65 40 20 72 6f 75 74 65 73 23 20 23 ss be@ routes# #
1cf0: 2e 6b 65 79 20 24 40 20 2e 73 6f 63 6b 61 64 64 .key $@ .sockadd
1d00: 72 20 3b 0a 0a 30 20 5b 49 46 5d 0a 4c 6f 63 61 r ;..0 [IF].Loca
1d10: 6c 20 56 61 72 69 61 62 6c 65 73 3a 0a 66 6f 72 l Variables:.for
1d20: 74 68 2d 6c 6f 63 61 6c 2d 77 6f 72 64 73 3a 0a th-local-words:.
1d30: 20 20 20 20 28 0a 20 20 20 20 20 28 28 22 6e 65 (. (("ne
1d40: 74 32 6f 3a 22 20 22 2b 6e 65 74 32 6f 3a 22 29 t2o:" "+net2o:")
1d50: 20 64 65 66 69 6e 69 74 69 6f 6e 2d 73 74 61 72 definition-star
1d60: 74 65 72 20 28 66 6f 6e 74 2d 6c 6f 63 6b 2d 6b ter (font-lock-k
1d70: 65 79 77 6f 72 64 2d 66 61 63 65 20 2e 20 31 29 eyword-face . 1)
1d80: 0a 20 20 20 20 20 20 22 5b 20 5c 74 5c 6e 5d 22 . "[ \t\n]"
1d90: 20 74 20 6e 61 6d 65 20 28 66 6f 6e 74 2d 6c 6f t name (font-lo
1da0: 63 6b 2d 66 75 6e 63 74 69 6f 6e 2d 6e 61 6d 65 ck-function-name
1db0: 2d 66 61 63 65 20 2e 20 33 29 29 0a 20 20 20 20 -face . 3)).
1dc0: 20 28 22 5b 61 2d 7a 30 2d 39 5d 2b 28 22 20 69 ("[a-z0-9]+(" i
1dd0: 6d 6d 65 64 69 61 74 65 20 28 66 6f 6e 74 2d 6c mmediate (font-l
1de0: 6f 63 6b 2d 63 6f 6d 6d 65 6e 74 2d 66 61 63 65 ock-comment-face
1df0: 20 2e 20 31 29 0a 20 20 20 20 20 20 22 29 22 20 . 1). ")"
1e00: 6e 69 6c 20 63 6f 6d 6d 65 6e 74 20 28 66 6f 6e nil comment (fon
1e10: 74 2d 6c 6f 63 6b 2d 63 6f 6d 6d 65 6e 74 2d 66 t-lock-comment-f
1e20: 61 63 65 20 2e 20 31 29 29 0a 20 20 20 20 29 0a ace . 1)). ).
1e30: 66 6f 72 74 68 2d 6c 6f 63 61 6c 2d 69 6e 64 65 forth-local-inde
1e40: 6e 74 2d 77 6f 72 64 73 3a 0a 20 20 20 20 28 0a nt-words:. (.
1e50: 20 20 20 20 20 28 28 22 6e 65 74 32 6f 3a 22 20 (("net2o:"
1e60: 22 2b 6e 65 74 32 6f 3a 22 29 20 28 30 20 2e 20 "+net2o:") (0 .
1e70: 32 29 20 28 30 20 2e 20 32 29 20 6e 6f 6e 2d 69 2) (0 . 2) non-i
1e80: 6d 6d 65 64 69 61 74 65 29 0a 20 20 20 20 29 0a mmediate). ).
1e90: 45 6e 64 3a 0a 5b 54 48 45 4e 5d 0a End:.[THEN].