ip.fs 10.4 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24
\ IP address stuff

\ Copyright (C) 2015   Bernd Paysan

\ 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 -- )
117
    ipv6(
118 119 120
    >r    r@ sin6_addr 12 + be-l!
    $FFFF r@ sin6_addr 8 + be-l!
    0     r@ sin6_addr 4 + l!
121 122
    0     r> sin6_addr l!
    )else( sin_addr be-l! ) ;
123 124 125 126 127 128 129 130 131 132 133 134 135 136

: ipv4!nat ( ipv4 sockaddr -- )
    \ nat64 version...
    >r        r@ sin6_addr 12 + be-l!
    0         r@ sin6_addr 8 + l!
    0         r@ sin6_addr 4 + l!
    $0064ff9b r> sin6_addr be-l! ;

: sock-rest ( sockaddr -- addr u ) >r
    AF_INET6 r@ family w!
    0        r@ sin6_flowinfo l!
    0        r@ sin6_scope_id l!
    r> sockaddr_in6 ;

137 138 139 140
: sock-rest4 ( sockaddr -- addr u ) >r
    AF_INET r@ family w!
    r> sockaddr_in4 ;

141
: my-port ( -- port )
142
    ipv6( )else( sockaddr_in4 )else( sockaddr_in6 ) alen !
143 144 145 146
    net2o-sock [IFDEF] no-hybrid drop [THEN] sockaddr1 alen getsockname ?ior
    sockaddr1 port be-uw@ ;

: sock[ ( -- )  query-sock ?EXIT
147 148
    ipv4( ipv6( new-udp-socket46 )else( new-udp-socket ) )else( new-udp-socket6 )
    to query-sock ;
149 150 151 152 153
: ]sock ( -- )  query-sock 0= ?EXIT
    query-sock closesocket 0 to query-sock ?ior ;

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

bernd's avatar
bernd committed
154
: fake-ip4? ( addr -- flag ) sin6_addr $C fake-ip4 over str= ;
155
: ?fake-ip4 ( -- addr u )
bernd's avatar
bernd committed
156
    sockaddr1 sin6_addr dup $C fake-ip4 over str= IF  12 + 4  ELSE  $10   THEN ;
157 158 159

29  Constant ESPIPE

160 161 162
: unavail? ( n -- flag )
    0< IF
	errno >r
bernd's avatar
bernd committed
163 164 165 166
	[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]
167 168 169 170
    ELSE
	false
    THEN ;

171 172 173 174 175 176 177 178
[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 ;

179
    : check-ip4 ( ip4addr -- my-ip4addr 4 ) ipv4(
180 181 182
	[: sockaddr_in4 alen !  53 sockaddr< port be-w!
	  sockaddr< sin_addr be-l! query-sock
	  sockaddr< sock-rest4 connect
183
	  dup unavail?  IF  drop ip6::0 4  EXIT  THEN  ?ior
184
	  query-sock sockaddr1 alen getsockname
185
	  dup unavail?  IF  drop ip6::0 4  EXIT  THEN  ?ior
186 187
	  sockaddr1 family w@ AF_INET6 =
	  IF  ?fake-ip4  ELSE  sockaddr1 sin_addr 4  THEN
188
	;] 'sock4 )else( 0 ) ;
189
[ELSE]
190 191
    : check-ip4 ( ip4addr -- my-ip4addr 4 ) ipv4(
	[:  ipv6( sockaddr_in6 )else( sockaddr_in4 ) alen !
192 193 194
	    53 sockaddr< port be-w!
	    sockaddr< ipv4! query-sock
	    sockaddr< ipv6( sock-rest )else( sock-rest4 ) connect
bernd's avatar
bernd committed
195 196 197 198 199
	    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
200
	;] 'sock )else( 0 ) ;
201 202 203
[THEN]

$25DDC249 Constant dummy-ipv4 \ this is my net2o ipv4 address
204 205
Create dummy-ipv6 \ this is googles ipv6 address
$2a c, $00 c, $14 c, $50 c, $40 c, $01 c, $08 c, $15 c,
206 207
$0000 w, $0000 w, $0000 w, $00 c, $01 c,
Create local-ipv6
208
$FD c, $00 c, $0000 w, $0000 w, $0000 w, $0000 w, $0000 w, $0000 w, $00 c, $01 c,
209 210 211 212 213 214

0 Value my-port#

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

215
: check-ip6 ( dummy -- ip6addr u ) ipv6(
216
    \G return IPv6 address - if length is 0, not reachable with IPv6
217 218 219
    [:  sockaddr_in6 alen !  53 sockaddr< port be-w!
	sockaddr< sin6_addr ip6!
	query-sock sockaddr< sock-rest connect
220
	dup unavail?  IF  drop ip6::0 $10  EXIT  THEN  ?ior
221
	query-sock sockaddr1 alen getsockname
222
	dup unavail?  IF  drop ip6::0 $10  EXIT  THEN  ?ior
223
	?fake-ip4
224
    ;] 'sock )else( 0 ) ;
225

226
: check-ip64 ( dummy -- ipaddr u ) ipv4(
227
    >r r@ check-ip6 dup IF  rdrop  EXIT  THEN
228
    2drop r> $10 + be-ul@ check-ip4 )else( check-ip6 ) ;
229

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

bernd's avatar
bernd committed
232
[IFDEF] no-hybrid
bernd's avatar
bernd committed
233 234 235 236 237 238
    : 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
239
    : try-ip ( addr u -- flag )
240
	ipv6(
bernd's avatar
bernd committed
241 242 243
	over fake-ip4? IF
	    fake6>ip4
	    ['] sock-connect? 'sock4
bernd's avatar
bernd committed
244
	ELSE
bernd's avatar
bernd committed
245 246
	    ['] sock-connect? 'sock
	THEN )else( ['] sock-connect? 'sock4 ) ;
bernd's avatar
bernd committed
247 248
[ELSE]
    : try-ip ( addr u -- flag )
bernd's avatar
bernd committed
249
	['] sock-connect? 'sock ;
bernd's avatar
bernd committed
250
[THEN]
251 252 253

: global-ip4 ( -- ip4addr u )  dummy-ipv4 check-ip4 ;
: global-ip6 ( -- ip6addr u )  dummy-ipv6 check-ip6 ;
bernd's avatar
bernd committed
254 255
: local-ip6 ( -- ip6addr u )   local-ipv6 check-ip6
    IF  c@ $FD =  ELSE  drop false  THEN ;
256 257 258 259 260 261 262

\ 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
263
	IF  addr fake-ip4?
264
	    IF
bernd's avatar
bernd committed
265
		sock2 pack u1 flag addr u2 fake6>ip4 sendto
266 267 268 269 270 271 272 273 274 275 276
	    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
277
\ new address handling is in addr.fs, loaded later
278

bernd's avatar
bernd committed
279
Forward !my-addr ( -- )
280 281 282 283 284 285 286 287 288 289 290 291

\ 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 -- )
292
    2dup ip6::0 over str= IF  smove  ELSE  2drop 2drop  THEN ;
293 294 295 296

\ insert address for punching

: !temp-addr ( addr u -- ) dup 0<> ind-addr !
297
    temp-addr dup $10 erase  $10 smove ;
298 299

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

: ping-addr1 ( -- )
Bernd Paysan's avatar
Bernd Paysan committed
303
    check-addr1 0= IF  nat( ticks .ticks ." don't ping: " 2dup .address cr )
Bernd Paysan's avatar
Bernd Paysan committed
304
	2drop  EXIT  THEN
305
    nat( ticks .ticks ."  ping: " 2dup .address cr )
Bernd Paysan's avatar
Bernd Paysan committed
306 307
    2>r net2o-sock
    [: 64#0 { 64^ x } '>' emit code-map .mapc:dest-vaddr x le-64!
308
	x 8 type punch# $10 type ;] $tmp
Bernd Paysan's avatar
Bernd Paysan committed
309
    0 2r> sendto drop ;
310

bernd's avatar
bernd committed
311
: pathc+ ( addr u -- addr' u' )
312 313 314
    BEGIN  dup  WHILE  over c@ $80 < >r 1 /string r>  UNTIL  THEN ;

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

319 320
\ Create udp socket

321
4242 Value net2o-port \ fix server port
322 323 324

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

325
: net2o-socket ( port -- )
326
    BEGIN  dup
327
	  ipv6( ipv4( [IFDEF] no-hybrid
328 329 330 331
	  ['] create-udp-server6 [ELSE] ['] create-udp-server46 [THEN]
	  )else( ['] create-udp-server6 )
	  )else( ['] create-udp-server )
	catch WHILE  drop 1+  REPEAT
332
    [IFDEF] no-hybrid 0 [THEN] to net2o-sock
333
    ?dup-0=-IF  my-port  THEN to my-port#
334
    [IFDEF] no-hybrid
bernd's avatar
bernd committed
335
	ipv4( net2o-sock drop my-port# create-udp-server to net2o-sock )
336 337 338
    [THEN]
    !my-addr ;

339
\\\
340 341 342 343 344 345 346 347 348 349 350 351 352 353
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]