ip.fs 11.3 KB
Newer Older
1 2
\ IP address stuff

Bernd Paysan's avatar
Bernd Paysan committed
3
\ Copyright © 2015   Bernd Paysan
4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24

\ This program is free software: you can redistribute it and/or modify
\ it under the terms of the GNU Affero General Public License as published by
\ the Free Software Foundation, either version 3 of the License, or
\ (at your option) any later version.

\ This program is distributed in the hope that it will be useful,
\ but WITHOUT ANY WARRANTY; without even the implied warranty of
\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
\ GNU Affero General Public License for more details.

\ You should have received a copy of the GNU Affero General Public License
\ along with this program.  If not, see <http://www.gnu.org/licenses/>.

\ IP address stuff

[IFDEF] no-hybrid
    0 0 2Value net2o-sock
[ELSE]
    0 Value net2o-sock
[THEN]
bernd's avatar
bernd committed
25
UValue query-sock
26 27
Variable my-addr[] \ object based hosts
Variable my-addr$ \ string based hosts (with sigs)
bernd's avatar
subme  
bernd committed
28
Variable pub-addr$ \ publicated addresses (with sigs)
bernd's avatar
bernd committed
29
Variable priv-addr$ \ unpublished addresses (with sigs)
30 31 32

Create fake-ip4  $0000 w, $0000 w, $0000 w, $0000 w, $0000 w, $FFFF w,
\ prefix for IPv4 addresses encoded as IPv6
33
Create nat64-ip4 $0064 wbe w, $ff9b wbe w, $0000 w, $0000 w, $0000 w, $0000 w,
34 35
\ prefix for IPv4 addresses via NAT64

Bernd Paysan's avatar
Bernd Paysan committed
36
: >alen ( addr -- alen )
bernd's avatar
bernd committed
37 38
    sockaddr_in6 sockaddr_in4 rot family w@ AF_INET6 = select ;

39 40 41 42 43
\ convention:
\ '!' is a key revocation, it contains the new key
\ Tags are kept sorted, so you'll get revocations first, then net2o and IPv6+4
\ Symbolic name may start with '@'+len followed by the name

44
Variable host$
45
$40 Constant max-host# \ maximum allowed size of a hostname is 63 characters
46

Bernd Paysan's avatar
Bernd Paysan committed
47
: get-host$ ( -- )
48 49
    max-host# host$ $!len
    host$ $@ gethostname drop host$ $@ drop cstring>sstring host$ $!len drop ;
Bernd Paysan's avatar
Bernd Paysan committed
50
: skip.site ( -- )
51 52
    host$ $@ s" .site" string-suffix? IF
	host$ dup $@len 5 - 5 $del
Bernd Paysan's avatar
Bernd Paysan committed
53 54
    THEN ;
: replace-host ( -- )
55 56
    config:orighost$ $@ host$ $@ str=
    config:host$ $@len 0> and  IF
57 58
	config:host$ $@ host$ $!
    ELSE
59
	host$ $@ 2dup config:orighost$ $!  config:host$ $!
60 61
	[IFDEF] android 20 [ELSE] 10 [THEN] \ mobile has lower prio
	config:prio# !
Bernd Paysan's avatar
Bernd Paysan committed
62 63 64
    THEN ;

: default-host ( -- )
65
    get-host$ skip.site replace-host ;
66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89

Create ip6::0 here 16 dup allot erase
: .ip6::0 ( -- )  ip6::0 $10 type ;
: .ip4::0 ( -- )  ip6::0 4 type ;

Create sockaddr" 2 c, $16 allot

: .port ( addr len -- addr' len' )
    ." :" over be-uw@ 0 ['] .r #10 base-execute  2 /string ;
: .net2o ( addr u -- ) dup IF  ." |" xtype  ELSE  2drop  THEN ;
: .ip4b ( addr len -- addr' len' )
    over c@ 0 ['] .r #10 base-execute 1 /string ;
: .ip4a ( addr len -- addr' len' )
    .ip4b ." ." .ip4b ." ." .ip4b ." ." .ip4b ;
: .ip4 ( addr len -- )
    .ip4a .port .net2o ;
User ip6:#
: .ip6w ( addr len -- addr' len' )
    over be-uw@ [: ?dup-IF 0 .r ip6:# off  ELSE  1 ip6:# +! THEN ;] $10 base-execute
    2 /string ;

: .ip6a ( addr len -- addr' len' )
    2dup fake-ip4 12 string-prefix? IF  12 /string .ip4a  EXIT  THEN
    -1 ip6:# !
90
    '[' over 2/ 0 DO  ip6:# @ 2 < IF  emit  ELSE drop  THEN .ip6w ':'  LOOP
91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111
    drop ." ]" ;
: .ip6 ( addr len -- )
    .ip6a .port .net2o ;

: .ip64 ( addr len -- )
    over $10 ip6::0 over str= IF  16 /string  ELSE  .ip6a  THEN
    over   4 ip6::0 over str= IF  4 /string   ELSE  .ip4a  THEN
    .port .net2o ;

: .address ( addr u -- )
    over w@ AF_INET6 =
    IF  drop dup sin6_addr $10 .ip6a 2drop
    ELSE  drop dup sin_addr 4 .ip4a 2drop  THEN
    port 2 .port 2drop ; 

\ NAT traversal stuff: print IP addresses

: skip-symname ( addr u -- addr' u' )
    over c@ '0' = IF  2 safe/string  THEN
    over c@ '?' - 0 max safe/string ;

bernd's avatar
bernd committed
112
Forward .addr$
113

bernd's avatar
bernd committed
114
: .iperr ( addr len -- )
115 116
    connect( [: <info> .time ." connected from: " .addr$ <default> cr ;] $err
    )else( 2drop ) ;
117 118

: ipv4! ( ipv4 sockaddr -- )
Bernd Paysan's avatar
Bernd Paysan committed
119 120
    ipv6(    tuck                             sin6_addr 12 + be-l!
    xlat464( nat64-ip4 )else( fake-ip4 ) swap sin6_addr $C move
121
    )else( sin_addr be-l! ) ;
122

123
: sock-id ( id sockaddr -- addr u ) >r
124
    AF_INET6 r@ family w!
Bernd Paysan's avatar
Bernd Paysan committed
125
    0        r@ sin6_flowinfo l!
126
             r@ sin6_scope_id l!
127 128
    r> sockaddr_in6 ;

129 130 131
: sock-rest ( sockaddr -- addr u )
    0 swap sock-id ;

132 133 134 135
: sock-rest4 ( sockaddr -- addr u ) >r
    AF_INET r@ family w!
    r> sockaddr_in4 ;

136
: my-port ( -- port )
Bernd Paysan's avatar
Bernd Paysan committed
137
    ipv6( sockaddr_in6 )else( sockaddr_in4 ) alen !
138 139 140
    net2o-sock [IFDEF] no-hybrid drop [THEN] sockaddr1 alen getsockname ?ior
    sockaddr1 port be-uw@ ;

141
: ipv6/pp ( sock -- sock )
142 143
    \ try to prefer public or private addresses
    \ if this is not available (e.g. WSL 1), just ignore
144 145
    [IFDEF] ipv6-public
	config:port# @ IF
146
	    ipv6( [: dup ipv6-public ;] catch drop )
147
	ELSE
148
	    ipv6( [: dup ipv6-private ;] catch drop )
149
	THEN
150 151 152
    [THEN]
;

153
: sock[ ( -- )  query-sock ?EXIT
154
    ipv4( ipv6( new-udp-socket46 )else( new-udp-socket ) )else( new-udp-socket6 )
155
    ipv6/pp to query-sock ;
156 157 158 159 160
: ]sock ( -- )  query-sock 0= ?EXIT
    query-sock closesocket 0 to query-sock ?ior ;

: 'sock ( xt -- )  sock[ catch ]sock throw ;

Bernd Paysan's avatar
Bernd Paysan committed
161 162 163
: fake-ip4? ( addr -- flag ) sin6_addr
    dup  $C fake-ip4  over str=
    swap $C nat64-ip4 over str= or ;
164
: ?fake-ip4 ( -- addr u )
Bernd Paysan's avatar
Bernd Paysan committed
165
    sockaddr1 dup sin6_addr $10 rot fake-ip4? $C and /string ;
166

Bernd Paysan's avatar
Bernd Paysan committed
167 168 169 170 171 172 173 174 175 176 177 178
: addr-v6= ( sockaddr -- sockaddr flag )
    dup fake-ip4? IF
	dup $C sin6_addr +  host:ipv4 4 tuck str=
	over sin6_port be-uw@  host:portv4 w@ = and
    ELSE
	dup sin6_addr host:ipv6 $10 tuck str=
	over sin6_port be-uw@  host:portv6 w@ = and
    THEN ;
: addr-v4= ( sockaddr -- sockaddr flag )
    dup sin_addr  host:ipv4 4 tuck str=
    over port be-uw@  host:portv4 w@ = and ;

179 180
29  Constant ESPIPE

181 182 183
: unavail? ( n -- flag )
    0< IF
	errno >r
bernd's avatar
bernd committed
184 185 186 187
	[IFDEF] EPFNOSUPPORT  r@ EPFNOSUPPORT  = [ELSE] 0 [THEN]
	[IFDEF] EAFNOSUPPORT  r@ EAFNOSUPPORT  = or [THEN]
	[IFDEF] EADDRNOTAVAIL r@ EADDRNOTAVAIL = or [THEN]
	[IFDEF] ENETUNREACH   r> ENETUNREACH   = or [ELSE] rdrop [THEN]
188 189 190 191
    ELSE
	false
    THEN ;

192 193 194 195 196 197 198 199
[IFDEF] no-hybrid
    : sock4[ ( -- )  query-sock ?EXIT
	new-udp-socket to query-sock ;
    : ]sock4 ( -- )  query-sock 0= ?EXIT
	query-sock closesocket 0 to query-sock ?ior ;

    : 'sock4 ( xt -- ) sock4[ catch ]sock4 throw ;

200
    : check-ip4 ( ip4addr -- my-ip4addr 4 ) ipv4(
Bernd Paysan's avatar
Bernd Paysan committed
201 202 203
	[: sockaddr_in4 alen !  53 sockaddr< port be-w!
	  sockaddr< sin_addr be-l! query-sock
	  sockaddr< sock-rest4 connect
204
	  dup unavail?  IF  drop ip6::0 4  EXIT  THEN  ?ior
205
	  query-sock sockaddr1 alen getsockname
206
	  dup unavail?  IF  drop ip6::0 4  EXIT  THEN  ?ior
207 208
	  sockaddr1 family w@ AF_INET6 =
	  IF  ?fake-ip4  ELSE  sockaddr1 sin_addr 4  THEN
209
	;] 'sock4 )else( 0 ) ;
210
[ELSE]
211 212
    : check-ip4 ( ip4addr -- my-ip4addr 4 ) ipv4(
	[:  ipv6( sockaddr_in6 )else( sockaddr_in4 ) alen !
Bernd Paysan's avatar
Bernd Paysan committed
213 214 215
	    53 sockaddr< port be-w!
	    sockaddr< ipv4! query-sock
	    sockaddr< ipv6( sock-rest )else( sock-rest4 ) connect
bernd's avatar
bernd committed
216 217 218 219 220
	    dup unavail?  IF  drop ip6::0 4  EXIT  THEN  ?ior
	    query-sock sockaddr1 alen getsockname
	    dup unavail?  IF  drop ip6::0 4  EXIT  THEN  ?ior
	    sockaddr1 family w@ AF_INET6 =
	    IF  ?fake-ip4  ELSE  sockaddr1 sin_addr 4  THEN
221
	;] 'sock )else( 0 ) ;
222 223
[THEN]

224 225
: be-w, here 2 allot be-w! ;

226
$25DDC249 Constant dummy-ipv4 \ this is my net2o ipv4 address
227 228 229
Create dummy-ipv6 \ this is my net2o ipv6 address
$2a03 be-w, $4000 be-w, $001d be-w, $00bf be-w,
$0000 be-w, $0000 be-w, $11e7 be-w, $0020 be-w,
230
Create local-ipv6
231 232 233
$FD00 be-w, $0000 w, $0000 w, $0000 w, $0000 w, $0000 w, $0000 w, $0001 be-w,
Create link-ipv6
$FE80 be-w, $0000 w, $0000 w, $0000 w, $0000 w, $0000 w, $0000 w, $0001 be-w,
234 235 236 237 238 239

0 Value my-port#

: ip6! ( addr1 addr2 -- ) $10 move ;
: ip6? ( addr -- flag )  $10 ip6::0 over str= 0= ;

240
: check-ip6 ( dummy -- ip6addr u ) ipv6(
241
    \G return IPv6 address - if length is 0, not reachable with IPv6
Bernd Paysan's avatar
Bernd Paysan committed
242 243 244
    [:  sockaddr_in6 alen !  53 sockaddr< port be-w!
	sockaddr< sin6_addr ip6!
	query-sock sockaddr< sock-rest connect
245
	dup unavail?  IF  drop ip6::0 $10  EXIT  THEN  ?ior
246
	query-sock sockaddr1 alen getsockname
247
	dup unavail?  IF  drop ip6::0 $10  EXIT  THEN  ?ior
248
	?fake-ip4
249
    ;] 'sock )else( 0 ) ;
250

251
: check-ip64 ( dummy -- ipaddr u ) ipv4(
252
    >r r@ check-ip6 dup IF  rdrop  EXIT  THEN
253
    2drop r> $10 + be-ul@ check-ip4 )else( check-ip6 ) ;
254

bernd's avatar
bernd committed
255 256
: sock-connect? ( addr u -- flag ) query-sock -rot connect 0= ;

bernd's avatar
bernd committed
257
[IFDEF] no-hybrid
bernd's avatar
bernd committed
258 259 260 261 262 263
    : fake6>ip4 ( addr u -- addr u' )
	drop >r
	AF_INET r@ family w!
	r@ sin6_addr $C + l@ r@ sin_addr l!
	r> sockaddr_in4 ;

bernd's avatar
bernd committed
264
    : try-ip ( addr u -- flag )
265
	ipv6(
bernd's avatar
bernd committed
266 267 268
	over fake-ip4? IF
	    fake6>ip4
	    ['] sock-connect? 'sock4
bernd's avatar
bernd committed
269
	ELSE
bernd's avatar
bernd committed
270 271
	    ['] sock-connect? 'sock
	THEN )else( ['] sock-connect? 'sock4 ) ;
bernd's avatar
bernd committed
272 273
[ELSE]
    : try-ip ( addr u -- flag )
bernd's avatar
bernd committed
274
	['] sock-connect? 'sock ;
bernd's avatar
bernd committed
275
[THEN]
276 277 278

: global-ip4 ( -- ip4addr u )  dummy-ipv4 check-ip4 ;
: global-ip6 ( -- ip6addr u )  dummy-ipv6 check-ip6 ;
bernd's avatar
bernd committed
279
: local-ip6 ( -- ip6addr u )   local-ipv6 check-ip6
280 281
    IF  c@ $FD =  ELSE  0  THEN ;
: link-ip6 ( -- ip6addr u -- ) link-ipv6 check-ip6 ;
282 283 284 285 286 287 288

\ no-hybrid stuff

[IFDEF] no-hybrid
    0 warnings !@
    : sendto { sock1 sock2 pack u1 flag addr u2 -- size }
	addr family w@ AF_INET6 =
bernd's avatar
bernd committed
289
	IF  addr fake-ip4?
290
	    IF
bernd's avatar
bernd committed
291
		sock2 pack u1 flag addr u2 fake6>ip4 sendto
292 293 294 295 296 297 298 299 300 301 302
	    ELSE
		sock1 pack u1 flag addr u2 sendto
	    THEN
	ELSE
	    sock2 pack u1 flag addr u2 sendto
	THEN ;
    warnings !
[THEN]

Variable myname

Bernd Paysan's avatar
Bernd Paysan committed
303
\ new address handling is in addr.fs, loaded later
304

bernd's avatar
bernd committed
305
Forward !my-addr ( -- )
306 307 308 309 310 311 312 313 314 315 316 317

\ this looks ok

: && ( flag -- ) ]] dup 0= ?EXIT drop [[ ; immediate compile-only
: &&' ( addr u addr' u' flag -- addr u false / addr u addr' u' )
    ]] 0= IF 2drop false EXIT THEN [[ ; immediate compile-only

: str=?0 ( addr1 u1 addr2 u2 -- flag )
    2dup ip6::0 over str= >r
    2over ip6::0 over str= >r str= r> r> or or ;

: str>merge ( addr1 u1 addr2 u2 -- )
318
    2dup ip6::0 over str= IF  smove  ELSE  2drop 2drop  THEN ;
319 320 321 322

\ insert address for punching

: !temp-addr ( addr u -- ) dup 0<> ind-addr !
323
    temp-addr dup $10 erase  $10 smove ;
324 325

: check-addr1 ( -- addr u flag )
bernd's avatar
bernd committed
326
    sockaddr1 ipv6( sock-rest )else( sock-rest4 ) 2dup try-ip ;
327 328

: ping-addr1 ( -- )
Bernd Paysan's avatar
Bernd Paysan committed
329
    check-addr1 0= IF  nat( ticks .ticks ." don't ping: " 2dup .address cr )
Bernd Paysan's avatar
Bernd Paysan committed
330
	2drop  EXIT  THEN
331
    nat( ticks .ticks ."  ping: " 2dup .address cr )
Bernd Paysan's avatar
Bernd Paysan committed
332
    2>r net2o-sock
Bernd Paysan's avatar
Bernd Paysan committed
333 334 335 336 337
    [: { | x[ 8 ] } '>' emit code-map .mapc:dest-vaddr x[ le-64!
      x[ 8 type punch# $10 type ;] $tmp
    0 2r@ sendto
    sendto( ." send to: " 2r@ .address space dup . cr )
    rdrop rdrop drop ;
338

bernd's avatar
bernd committed
339
: pathc+ ( addr u -- addr' u' )
340 341 342
    BEGIN  dup  WHILE  over c@ $80 < >r 1 /string r>  UNTIL  THEN ;

: .addr-path ( addr -- )
Bernd Paysan's avatar
Bernd Paysan committed
343
    dup be@ routes# #.key dup 0= IF  drop $10 xtype  ELSE
344
	$@ .address
bernd's avatar
bernd committed
345
	$10 pathc+ 0 -skip dup IF  '|' emit  THEN xtype  THEN ;
346

347 348
\ Create udp socket

Bernd Paysan's avatar
Bernd Paysan committed
349
4242 Value net2o-port \ fix server port
350 351 352

Variable net2o-host "net2o.de" net2o-host $!

353
: net2o-socket ( port -- )
Bernd Paysan's avatar
Bernd Paysan committed
354
    BEGIN  dup
355
	  ipv6( ipv4( [IFDEF] no-hybrid
Bernd Paysan's avatar
Bernd Paysan committed
356 357 358 359
	  ['] create-udp-server6 [ELSE] ['] create-udp-server46 [THEN]
	  )else( ['] create-udp-server6 )
	  )else( ['] create-udp-server )
	catch WHILE  drop 1+  REPEAT
360
    ipv6/pp  [IFDEF] no-hybrid 0 [THEN] to net2o-sock
361
    ?dup-0=-IF  my-port  THEN to my-port#
362
    [IFDEF] no-hybrid
bernd's avatar
bernd committed
363
	ipv4( net2o-sock drop my-port# create-udp-server to net2o-sock )
364
    [THEN]
Bernd Paysan's avatar
Fix  
Bernd Paysan committed
365
    !my-addr ;
366

367
\\\
368 369 370 371 372 373 374 375 376 377 378 379 380 381
Local Variables:
forth-local-words:
    (
     (("net2o:" "+net2o:") definition-starter (font-lock-keyword-face . 1)
      "[ \t\n]" t name (font-lock-function-name-face . 3))
     ("[a-z0-9]+(" immediate (font-lock-comment-face . 1)
      ")" nil comment (font-lock-comment-face . 1))
    )
forth-local-indent-words:
    (
     (("net2o:" "+net2o:") (0 . 2) (0 . 2) non-immediate)
    )
End:
[THEN]