Artifact d3abec98100bb982dea8fc457d3f1502900e7d19:

• File linux/net.fs — part of check-in [bb3039ab0a] at 2019-04-24 21:20:03 on branch trunk — Check online status (user: bernd size: 4750)

\ Linux specific network stuff

\ Copyright (C) 2016   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/>.

$200 Constant netlink-size#
0 Value netlink-sock
sockaddr_nl buffer: netlink-addr
netlink-size# buffer: netlink-buffer

AF_NETLINK netlink-addr nl_family w!
0          netlink-addr nl_pad w!
$00d8607f5 netlink-addr nl_groups l!

: prep-netlink ( -- )
    epiper @ fileno POLLIN  pollfds fds!+ >r
    netlink-sock POLLIN  r> fds!+
    pollfds - pollfd / to pollfd# ;

: get-netlink ( -- )
    PF_NETLINK SOCK_DGRAM NETLINK_ROUTE socket dup ?ior to netlink-sock
    getpid     [ netlink-addr nl_pid ]L l!
    netlink-sock netlink-addr sockaddr_nl bind ?ior
    prep-netlink ;

: netlink? ( -- flag )
    pollfds pollfd# >poll drop read-event
    pollfds [ pollfd revents ]L + w@ POLLIN and ;

: wait-for-netlink ( -- )
    BEGIN  netlink? 0= WHILE  ?events  REPEAT ;

: read-netlink ( -- addr u )
    netlink-sock netlink-buffer netlink-size# MSG_DONTWAIT recv dup ?ior-again
    netlink-buffer netlink-buffer l@ rot umin ;

: read-netlink? ( -- addr u )
    poll-timeout# 0 ptimeout 2!  wait-for-netlink
    read-netlink ;

: address? ( addr u -- flag )
    0= IF  drop false  EXIT  THEN
    nlmsg_type w@ RTM_NEWLINK [ RTM_DELADDR 1+ ]L within ;

\ debugging stuff to see what kind of things are going on

: .rtaddr4 ( addr -- ) $C + 4 .ip4a 2drop ;
: .rtaddr6 ( addr -- ) $C + $10 .ip6a 2drop ;
: .ifam-flags ( n -- )
    ifa-f$ bounds DO
	dup 1 and IF  I c@ emit  THEN  2/
    LOOP  drop ;
: .ifam-addr ( addr -- )
    case  dup ifam_family c@
	AF_INET  of  .rtaddr4  endof
	AF_INET6 of  .rtaddr6  endof
	nip endcase ;
: .rtmsg ( addr -- )
    case nlmsg_type w@
	RTM_NEWADDR of ." add " endof
	RTM_DELADDR of ." del " endof
    endcase ;
: .rtaddr ( addr u -- ) drop
    dup .rtmsg  nlmsghdr +
    dup ifam_index l@ 0 .r ." : "
    dup ifam_flags c@ .ifam-flags .ifam-addr
    cr ;
: netlink-test ( -- )
    netlink-sock 0= IF  get-netlink  THEN
    BEGIN  key? 0= WHILE
	    read-netlink
	    2dup address? IF .rtaddr 20 ms
		global-ip4 .ip4a 2drop
		global-ip6 .ip6a 2drop cr
	    ELSE 2drop THEN
    REPEAT ;

\ renat handshale

0 Value netlink-task
Variable netlink-done?   netlink-done? on
Variable netlink-again?  netlink-again? off
Defer addr-changed ' noop is addr-changed

event: :>netlink ( -- )
    netlink-again? @ IF
	 netlink-done? off netlink-again? off #0. dht-beacon
    ELSE  netlink-done? on  THEN ;
event: :>addr-changed ( -- )
    addr-changed ;
: renat-complete ( -- )
    <event :>netlink netlink-task event> ;

\ netlink watchdog

2 constant netlink-wait#

: check-preferred? ( -- flag )
    0 my-addr[] $[] @ >o
    global-ip6 2dup str0? { v6z } host:ipv6 $10 str= >r
    global-ip4 2dup str0? { v4z } host:ipv4   4 str= r> and 0=
    v6z v4z and 0= to connected?
    o>  connected? and ;

: new-preferred? ( -- flag )
    netlink-wait# ptimeout ! \ 3s wait in total
    BEGIN  netlink? WHILE  read-netlink
	netlink( 2dup address? IF  2dup .rtaddr THEN )  2drop
    REPEAT
    check-preferred? ;
: wait-for-address ( -- )
    BEGIN  read-netlink?
	netlink( 2dup address? IF  2dup .rtaddr THEN )
    address? check-preferred? or  UNTIL ;
: netlink-loop ( -- )
    netlink-sock 0= IF  get-netlink  THEN
    BEGIN
	wait-for-address  !!0depth!!
	new-preferred? IF
	    nat( ." new preferred IP: " )
	    netlink-done? @ IF
		nat( ." dht-beacon" cr )
		netlink-done? off netlink-again? off
		beacons-now! !!0depth!!
	    ELSE
		nat( ." netlink-again" cr ) netlink-again? on  !!0depth!!
	    THEN
	    <event :>addr-changed [ up@ ]L event>
	THEN
    AGAIN ;
: create-netlink-task ( -- )
    ['] netlink-loop 1 net2o-task to netlink-task ;

:noname defers init-rest create-netlink-task ; is init-rest

\\\
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]