ip.fs 11 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
bernd committed
28
Variable pub-addr$ \ publicated addresses (with sigs)
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

36
: >alen ( addr -- alen )
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 45
Variable host$

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

: default-host ( -- )
63
    get-host$ skip.site replace-host ;
64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109

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:# !
    '[' 8 0 DO  ip6:# @ 2 < IF  emit  ELSE drop  THEN .ip6w ':'  LOOP
    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
110
Forward .addr$
111

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

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

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

127 128 129
: sock-rest ( sockaddr -- addr u )
    0 swap sock-id ;

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

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

139
: ipv6/pp ( sock -- sock )
140 141 142 143 144 145
    [IFDEF] ipv6-public
	config:port# @ IF
	    ipv6( dup ipv6-public )
	ELSE
	    ipv6( dup ipv6-private )
	THEN
146 147 148
    [THEN]
;

149
: sock[ ( -- )  query-sock ?EXIT
150
    ipv4( ipv6( new-udp-socket46 )else( new-udp-socket ) )else( new-udp-socket6 )
151
    ipv6/pp to query-sock ;
152 153 154 155 156
: ]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
157 158 159
: fake-ip4? ( addr -- flag ) sin6_addr
    dup  $C fake-ip4  over str=
    swap $C nat64-ip4 over str= or ;
160
: ?fake-ip4 ( -- addr u )
Bernd Paysan's avatar
Bernd Paysan committed
161
    sockaddr1 dup sin6_addr $10 rot fake-ip4? $C and /string ;
162

163 164 165 166 167 168 169 170 171 172 173 174
: 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 ;

175 176
29  Constant ESPIPE

177 178 179
: unavail? ( n -- flag )
    0< IF
	errno >r
bernd's avatar
bernd committed
180 181 182 183
	[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]
184 185 186 187
    ELSE
	false
    THEN ;

188 189 190 191 192 193 194 195
[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 ;

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

220 221
: be-w, here 2 allot be-w! ;

222
$25DDC249 Constant dummy-ipv4 \ this is my net2o ipv4 address
223 224 225
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,
226
Create local-ipv6
227 228 229
$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,
230 231 232 233 234 235

0 Value my-port#

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

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

247
: check-ip64 ( dummy -- ipaddr u ) ipv4(
248
    >r r@ check-ip6 dup IF  rdrop  EXIT  THEN
249
    2drop r> $10 + be-ul@ check-ip4 )else( check-ip6 ) ;
250

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

bernd's avatar
bernd committed
253
[IFDEF] no-hybrid
bernd's avatar
bernd committed
254 255 256 257 258 259
    : 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
260
    : try-ip ( addr u -- flag )
261
	ipv6(
bernd's avatar
bernd committed
262 263 264
	over fake-ip4? IF
	    fake6>ip4
	    ['] sock-connect? 'sock4
bernd's avatar
bernd committed
265
	ELSE
bernd's avatar
bernd committed
266 267
	    ['] sock-connect? 'sock
	THEN )else( ['] sock-connect? 'sock4 ) ;
bernd's avatar
bernd committed
268 269
[ELSE]
    : try-ip ( addr u -- flag )
bernd's avatar
bernd committed
270
	['] sock-connect? 'sock ;
bernd's avatar
bernd committed
271
[THEN]
272 273 274

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

\ 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
285
	IF  addr fake-ip4?
286
	    IF
bernd's avatar
bernd committed
287
		sock2 pack u1 flag addr u2 fake6>ip4 sendto
288 289 290 291 292 293 294 295 296 297 298
	    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
299
\ new address handling is in addr.fs, loaded later
300

bernd's avatar
bernd committed
301
Forward !my-addr ( -- )
302 303 304 305 306 307 308 309 310 311 312 313

\ 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 -- )
314
    2dup ip6::0 over str= IF  smove  ELSE  2drop 2drop  THEN ;
315 316 317 318

\ insert address for punching

: !temp-addr ( addr u -- ) dup 0<> ind-addr !
319
    temp-addr dup $10 erase  $10 smove ;
320 321

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

: ping-addr1 ( -- )
Bernd Paysan's avatar
Bernd Paysan committed
325
    check-addr1 0= IF  nat( ticks .ticks ." don't ping: " 2dup .address cr )
Bernd Paysan's avatar
Bernd Paysan committed
326
	2drop  EXIT  THEN
327
    nat( ticks .ticks ."  ping: " 2dup .address cr )
Bernd Paysan's avatar
Bernd Paysan committed
328
    2>r net2o-sock
Bernd Paysan's avatar
Bernd Paysan committed
329 330 331 332 333
    [: { | 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 ;
334

bernd's avatar
bernd committed
335
: pathc+ ( addr u -- addr' u' )
336 337 338
    BEGIN  dup  WHILE  over c@ $80 < >r 1 /string r>  UNTIL  THEN ;

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

343 344
\ Create udp socket

345
4242 Value net2o-port \ fix server port
346 347 348

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

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

363
\\\
364 365 366 367 368 369 370 371 372 373 374 375 376 377
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]