Artifact 19c7c61ea24933c3458cd01ad3a514a3d3ab72af:
- File ip.fs — part of check-in [531f5bc61f] at 2019-01-16 17:45:30 on branch trunk — Replace 0 [IF] for emacs editings with \\\ (user: bernd size: 10632)
\ 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] UValue query-sock Variable my-addr[] \ object based hosts Variable my-addr$ \ string based hosts (with sigs) Variable pub-addr$ \ publicated addresses (with sigs) Variable priv-addr$ \ unpublished addresses (with sigs) Create fake-ip4 $0000 w, $0000 w, $0000 w, $0000 w, $0000 w, $FFFF w, \ prefix for IPv4 addresses encoded as IPv6 Create nat64-ip4 $0064 wbe w, $ff9b wbe w, $0000 w, $0000 w, $0000 w, $0000 w, \ prefix for IPv4 addresses via NAT64 : >alen ( addr -- alen ) sockaddr_in6 sockaddr_in4 rot family w@ AF_INET6 = select ; \ 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 Variable host$ : get-host$ ( -- ) pad $100 gethostname drop pad cstring>sstring host$ $! ; : skip.site ( -- ) host$ $@ s" .site" string-suffix? IF host$ dup $@len 5 - 5 $del THEN ; : replace-host ( -- ) config:orighost$ $@ host$ $@ str= config:host$ $@len 0> and IF config:host$ $@ host$ $! ELSE host$ $@ 2dup config:orighost$ $! config:host$ $! [IFDEF] android 20 [ELSE] 10 [THEN] \ mobile has lower prio config:prio# ! THEN ; : default-host ( -- ) get-host$ skip.site replace-host ; 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 ; Forward .addr$ : .iperr ( addr len -- ) connect( [: <info> .time ." connected from: " .addr$ <default> cr ;] $err )else( 2drop ) ; : ipv4! ( ipv4 sockaddr -- ) ipv6( >r r@ sin6_addr 12 + be-l! $FFFF r@ sin6_addr 8 + be-l! 0 r@ sin6_addr 4 + l! 0 r> sin6_addr l! )else( sin_addr be-l! ) ; : 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 ; : sock-rest4 ( sockaddr -- addr u ) >r AF_INET r@ family w! r> sockaddr_in4 ; : my-port ( -- port ) ipv6( )else( sockaddr_in4 )else( sockaddr_in6 ) alen ! net2o-sock [IFDEF] no-hybrid drop [THEN] sockaddr1 alen getsockname ?ior sockaddr1 port be-uw@ ; : sock[ ( -- ) query-sock ?EXIT ipv4( ipv6( new-udp-socket46 )else( new-udp-socket ) )else( new-udp-socket6 ) to query-sock ; : ]sock ( -- ) query-sock 0= ?EXIT query-sock closesocket 0 to query-sock ?ior ; : 'sock ( xt -- ) sock[ catch ]sock throw ; : fake-ip4? ( addr -- flag ) sin6_addr $C fake-ip4 over str= ; : ?fake-ip4 ( -- addr u ) sockaddr1 sin6_addr dup $C fake-ip4 over str= IF 12 + 4 ELSE $10 THEN ; 29 Constant ESPIPE : unavail? ( n -- flag ) 0< IF errno >r [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] ELSE false THEN ; [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 ; : check-ip4 ( ip4addr -- my-ip4addr 4 ) ipv4( [: sockaddr_in4 alen ! 53 sockaddr< port be-w! sockaddr< sin_addr be-l! query-sock sockaddr< sock-rest4 connect 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 ;] 'sock4 )else( 0 ) ; [ELSE] : check-ip4 ( ip4addr -- my-ip4addr 4 ) ipv4( [: ipv6( sockaddr_in6 )else( sockaddr_in4 ) alen ! 53 sockaddr< port be-w! sockaddr< ipv4! query-sock sockaddr< ipv6( sock-rest )else( sock-rest4 ) connect 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 ;] 'sock )else( 0 ) ; [THEN] $25DDC249 Constant dummy-ipv4 \ this is my net2o ipv4 address Create dummy-ipv6 \ this is googles ipv6 address $2a c, $00 c, $14 c, $50 c, $40 c, $01 c, $08 c, $15 c, $0000 w, $0000 w, $0000 w, $00 c, $01 c, Create local-ipv6 $FD c, $00 c, $0000 w, $0000 w, $0000 w, $0000 w, $0000 w, $0000 w, $00 c, $01 c, 0 Value my-port# : ip6! ( addr1 addr2 -- ) $10 move ; : ip6? ( addr -- flag ) $10 ip6::0 over str= 0= ; : check-ip6 ( dummy -- ip6addr u ) ipv6( \G return IPv6 address - if length is 0, not reachable with IPv6 [: sockaddr_in6 alen ! 53 sockaddr< port be-w! sockaddr< sin6_addr ip6! query-sock sockaddr< sock-rest connect dup unavail? IF drop ip6::0 $10 EXIT THEN ?ior query-sock sockaddr1 alen getsockname dup unavail? IF drop ip6::0 $10 EXIT THEN ?ior ?fake-ip4 ;] 'sock )else( 0 ) ; : check-ip64 ( dummy -- ipaddr u ) ipv4( >r r@ check-ip6 dup IF rdrop EXIT THEN 2drop r> $10 + be-ul@ check-ip4 )else( check-ip6 ) ; : sock-connect? ( addr u -- flag ) query-sock -rot connect 0= ; [IFDEF] no-hybrid : 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 ; : try-ip ( addr u -- flag ) ipv6( over fake-ip4? IF fake6>ip4 ['] sock-connect? 'sock4 ELSE ['] sock-connect? 'sock THEN )else( ['] sock-connect? 'sock4 ) ; [ELSE] : try-ip ( addr u -- flag ) ['] sock-connect? 'sock ; [THEN] : global-ip4 ( -- ip4addr u ) dummy-ipv4 check-ip4 ; : global-ip6 ( -- ip6addr u ) dummy-ipv6 check-ip6 ; : local-ip6 ( -- ip6addr u ) local-ipv6 check-ip6 IF c@ $FD = ELSE drop false THEN ; \ no-hybrid stuff [IFDEF] no-hybrid 0 warnings !@ : sendto { sock1 sock2 pack u1 flag addr u2 -- size } addr family w@ AF_INET6 = IF addr fake-ip4? IF sock2 pack u1 flag addr u2 fake6>ip4 sendto ELSE sock1 pack u1 flag addr u2 sendto THEN ELSE sock2 pack u1 flag addr u2 sendto THEN ; warnings ! [THEN] Variable myname \ new address handling is in addr.fs, loaded later Forward !my-addr ( -- ) \ 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 -- ) 2dup ip6::0 over str= IF smove ELSE 2drop 2drop THEN ; \ insert address for punching : !temp-addr ( addr u -- ) dup 0<> ind-addr ! temp-addr dup $10 erase $10 smove ; : check-addr1 ( -- addr u flag ) sockaddr1 ipv6( sock-rest )else( sock-rest4 ) 2dup try-ip ; : ping-addr1 ( -- ) check-addr1 0= IF nat( ticks .ticks ." don't ping: " 2dup .address cr ) 2drop EXIT THEN nat( ticks .ticks ." ping: " 2dup .address cr ) 2>r net2o-sock [: 64#0 { 64^ x } '>' emit code-map .mapc:dest-vaddr x le-64! x 8 type punch# $10 type ;] $tmp 0 2r> sendto drop ; : pathc+ ( addr u -- addr' u' ) BEGIN dup WHILE over c@ $80 < >r 1 /string r> UNTIL THEN ; : .addr-path ( addr -- ) dup be@ routes# #.key dup 0= IF drop $10 xtype ELSE $@ .address $10 pathc+ 0 -skip dup IF '|' emit THEN xtype THEN ; \ Create udp socket 4242 Value net2o-port \ fix server port Variable net2o-host "net2o.de" net2o-host $! : net2o-socket ( port -- ) BEGIN dup ipv6( ipv4( [IFDEF] no-hybrid ['] create-udp-server6 [ELSE] ['] create-udp-server46 [THEN] )else( ['] create-udp-server6 ) )else( ['] create-udp-server ) catch WHILE drop 1+ REPEAT [IFDEF] no-hybrid 0 [THEN] to net2o-sock ?dup-0=-IF my-port THEN to my-port# [IFDEF] no-hybrid ipv4( net2o-sock drop my-port# create-udp-server to net2o-sock ) [THEN] !my-addr ; \\\ 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]