\ io per-task variables

user-o io-mem

object class
    pollfd 4 *      uvar pollfds \ up to four file descriptors
    sockaddr_in     uvar sockaddr< \ incoming socket
    sockaddr_in     uvar sockaddr> \ outgoing socket
    sockaddr_in     uvar sockaddr1
    [IFDEF] no-hybrid
	sockaddr_in uvar sockaddr2
    [THEN]
    file-stat       uvar statbuf
    aligned
    cell            uvar ind-addr

    LOOP  2drop -1 ;

: #.key ( path hash -- item ) @ { hash }
    BEGIN
	hash 0= IF  drop 0  EXIT  THEN
	$100 um* dup $80 and WHILE
	    $80 + cells hash + @ to hash
    REPEAT \ stack: pathlow pathhigh (<=$7F)
    nip 2* cells hash + ;

: #map  { hash xt -- } \ xt: ( ... node -- ... )
    hash @ 0= ?EXIT
    hash @ $100 cells bounds DO
	I @ IF  I xt execute  THEN
    2 cells +LOOP

    need-beacon# @ IF
	2dup check-beacon-hash 0= IF
	    beacon( ticks .ticks ."  wrong beacon hash"
	    85type ."  instead of " my-beacon $@ 85type cr )else( 2drop )  EXIT
	THEN
    THEN  2drop
    net2o-sock
    sockaddr< alen @ routes# #@ dup 0= IF  2drop "!"  THEN
    beacon( ticks .ticks ."  Send '" 2dup type ." ' reply to: " sockaddr< alen @ .address forth:cr )
    0 sockaddr< alen @ sendto drop +send ;
: !-beacon ( addr u -- ) 2drop
    \G I got a reply, my address is unknown
    beacon( ticks .ticks ."  Got unknown reply: " sockaddr< alen @ .address forth:cr )
    sockaddr< alen @ beacons #@ d0<> IF  last# do-beacon  THEN ;
: .-beacon ( addr u -- ) 2drop
    \G I got a reply, my address is known
    beacon( ticks .ticks ."  Got known reply: " sockaddr< alen @ .address forth:cr )
    sockaddr< alen @ beacons #@ IF
	>r r@ 64@ ticks 64umin beacon-ticks# 64+ r> 64!
    THEN ;
: >-beacon ( addr u -- )
    \G I got a punch
    nat( ticks .ticks ."  Got punch: " sockaddr< alen @ .address forth:cr )
    check-punch-hash ?dup-IF
	\ !!FIXME!! accept only two: one IPv4, one IPv6.
	\ !!FIXME!! and try merging the two into existent
	>o sockaddr< alen @ nat( ." +punch " 2dup .address forth:cr )
	.sockaddr new-addr punch-addrs >stack o>
    THEN ;

: handle-beacon ( addr u char -- )
    case
	'?' of  ?-beacon  endof
	'!' of  !-beacon  endof

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 w, $ff9b 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

	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]

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(

: save-msgs& ( -- )
    <event last# elit, :>save-msgs ?file-task event> ;

: ?msg-log ( addr u -- )  msg-logs ?hash ;

0 Value log#
2Variable last-msg

: +msg-log ( addr u -- addr' u' / 0 0 )
    last# $@ ?msg-log
    [: last# cell+ $ins[]date  dup to log#
      dup -1 = IF drop #0. ( 0 to last# )  ELSE  last# cell+ $[]@  THEN
    ;] msglog-sema c-section 2dup last-msg 2! ;
: ?save-msg ( addr u -- )
    ?msg-log
    last# otr-mode @ replay-mode @ or 0= and
    IF  save-msgs&  THEN ;

Sema queue-sema

\ peer queue

: peer> ( -- addr / 0 )
    [: peers[] back> ;] queue-sema c-section ;
: >peer ( addr u -- )
    [: peers[] $+[]! ;] queue-sema c-section ;

\ events

: >msg-log ( addr u -- addr' u )
    last# >r +msg-log last# ?dup-IF  $@ ?save-msg  THEN  r> to last# ;







: do-msg-nestsig ( addr u -- )
    parent .msg-context @ .msg:display msg-notify ;

: display-lastn ( addr u n -- )  reset-time
    0 otr-mode
    [: net2o:new-msg >o 0 to parent
	cells >r ?msg-log last# msg-log@ 2dup { log u }

: chat-rqd-nonat ( n -- )
    reconnect( ." chat req done, start silent join" cr )
    connect-rest  +flow-control +resend chat-silent-join ;

User peer-buf

: reconnect-chat ( addr u $chat -- )
    peer-buf $!buf  last# peer-buf $@
    reconnect( ." reconnect " 2dup 2dup + 1- c@ 1+ - .addr$ cr )
    reconnect( ." in group: " last# dup hex. $. cr )
    0 >o $A $A [: reconnect( ." prepare reconnection" cr )
      ?msg-context >o silent-last# ! o>
      ['] chat-rqd-nat ['] chat-rqd-nonat ind-addr @ select rqd! ;]
    addr-connect 2dup d0= IF  2drop  ELSE  avalanche-to  THEN o> ;

event: :>avalanche ( addr u o group -- )
    avalanche( ." Avalanche to: " dup hex. cr )
    to last# .avalanche-msg ;
event: :>chat-reconnect ( addr u $chat o group -- )
    to last# .reconnect-chat ;
event: :>msg-nestsig ( $addr o group -- )
    to last# >o { w^ m } m $@ do-msg-nestsig m $free o>
    ctrl L inskey ;

\ coordinates

    wait-task @ ?dup-IF  <hide>  THEN
    o> ;
+net2o: msg-leave ( $:group -- ) \g leave a chat group
    $> msg-groups #@ d0<> IF
	parent last# cell+ del$cell  THEN ;
+net2o: msg-reconnect ( $:pubkey+addr -- ) \g rewire distribution tree
    $> $make
    <event last-msg 2@ e$, elit, o elit, last# elit, :>chat-reconnect
    parent .wait-task @ ?query-task over select event> ;
+net2o: msg-last? ( start end n -- ) 64>n msg:last? ;
+net2o: msg-last ( $:[tick0,msgs,..tickn] n -- ) 64>n msg:last ;

: ?pkgroup ( addr u -- addr u )
    \ if no group has been selected, use the pubkey as group
    last# 0= IF  2dup + sigpksize# - keysize >group  THEN ;

    \G end a msg block by adding a signature
    otr-mode @ IF  now>otr  ELSE  now>never  THEN ]pksign ;
: msg-otr> ( -- )
    \G end a msg block by adding a short-time signature
    now>otr ]pksign ;
: msg-log, ( -- addr u )
    last-signed 2@ >msg-log ;



previous

: ?destpk ( addr u -- addr' u' )
    2dup pubkey $@ key| str= IF  2drop pk@ key|  THEN ;

: last-signdate@ ( -- 64date )

: reconnects, ( group -- )
    cell+ $@ cell safe/string bounds U+DO
	I @ .reconnect,
    cell +LOOP ;

: send-reconnects ( group o:connection -- )  o to connection
    net2o-code expect-msg
    [: dup  $@ ?destpk 2dup >group $, msg-leave
	sign[ msg-start "left" $, msg-action msg-otr>
	reconnects, ;] [msg,]
    end-code| ;

: send-reconnect1 ( o o:connection -- ) o to connection
    net2o-code expect-msg
    [: last# $@ $, msg-leave
	sign[ msg-start "left" $, msg-action msg-otr>
	.reconnect, ;] [msg,]
    end-code| ;
previous

: send-reconnect ( group -- )
    dup cell+ $@
    case
	0    of  2drop  endof

    [:  \ ." created sender task " up@ hex. cr
	prep-evsocks send-loop ;] 1 net2o-task to sender-task ;

Forward handle-beacon
Forward handle-beacon+hash

: add-source ( -- )
    sockaddr< alen @ insert-address inbuf ins-source ;

: next-packet ( -- addr u )
    sender-task 0= IF  send-read-packet  ELSE  try-read-packet-wait  THEN
    dup minpacket# u>= IF
	( nat( ." packet from: " sockaddr< alen @ .address cr )
	over packet-size over <>
	header( ~~ !!size!! )else( IF  2drop 0 0 EXIT  !!size!!  THEN )
	+next
	EXIT
    THEN
    dup $19 u<= IF    handle-beacon+hash   0 0  EXIT  THEN ;

    c-state @ -rot swap within !!inv-order!! r> c-state or! ;
: !!<>=order?   ( n1 n2 -- )  dup >r 1+
    c-state @ -rot swap within !!inv-order!! r> c-state or! ;

User remote?

: handle-cmd0 ( -- ) \ handle packet to address 0
    cmd0( .time ." handle cmd0 " sockaddr< alen @ .address cr )
    0 >o rdrop remote? on \ address 0 has no job context!
    inbuf0-decrypt 0= IF
	invalid( ." invalid packet to 0" cr ) EXIT  THEN
    add-source  >ret-addr
    validated off     \ we have no validated encryption, only anonymous
    do-keypad sec-free \ no key exchange may have happened
    $error-id $off    \ no error id so far

	    THEN  EXIT  THEN +dest
	handle-dest
    THEN ;

: route-packet ( -- )
    add-source
    inbuf >r r@ get-dest route>address IF
	route( ." route to: " sockaddr> alen @ .address space
	inbuf destination .addr-path cr )
	r@ dup packet-size send-a-packet 0<
	IF  ." failed to send from: " sockaddr< dup >alen .address
	    ."  to: " sockaddr> alen @ .address cr true ?ior  THEN
    THEN  rdrop ;

\ dispose context

: unlink-ctx ( next hit ptr -- )
    next-context @ o contexts
    BEGIN  2dup @ <> WHILE  @ dup .next-context swap 0= UNTIL

:noname o-beacon defers extra-dispose ; is extra-dispose

: gen-beacon-hash ( -- hash u )
    dest-0key sec@ "beacon" keyed-hash#128 2/ ;

: add-beacon ( net2oaddr xt -- )
    >r route>address IF
	sockaddr> alen @ r@ +beacon
	o IF
	    s" ?" beacon-hash $!  gen-beacon-hash beacon-hash $+!
	THEN
    THEN  rdrop ;
: ret+beacon ( -- )  ret-addr be@ ['] 2drop add-beacon ;

\ timeout loop

    rec-droprate# IF  rng32 rec-droprate# u< IF
	    resend( ." dropping incoming packet" cr )
	    2drop #0.  THEN  THEN ;

: read-a-packet ( blockage -- addr u / 0 0 )
    >r sockaddr_in alen !
    net2o-sock [IFDEF] no-hybrid drop [THEN]
    inbuf maxpacket r> sockaddr< alen recvfrom
    dup 0< IF
	errno dup EAGAIN =  IF  2drop #0. EXIT  THEN
	#512 + negate throw  THEN
    inbuf swap  1 packetr +!  ?drop-inc
    recvfrom( ." received from: " sockaddr< alen @ .address space dup . cr )
;

[IFDEF] no-hybrid
    : read-a-packet4 ( blockage -- addr u / 0 0 )
	>r sockaddr_in alen !
	net2o-sock nip
	inbuf maxpacket r> sockaddr< alen recvfrom
	dup 0< IF
	    errno dup EAGAIN =  IF  2drop #0. EXIT  THEN
	THEN
	inbuf swap  1 packetr +!  ?drop-inc
	recvfrom( ." received from: " sockaddr< alen @ .address space dup . cr )
    ;
[THEN]

$00000000 Value droprate#

: %droprate ( -- )
    ?peekarg 0= IF  EXIT  THEN

	THEN
    THEN ;

: send-a-packet ( addr u -- n ) +calc
    droprate# IF  rng32 droprate# u< IF
	    resend( ." dropping packet" cr )
	    1 packets +! 2drop 0  EXIT  THEN  THEN
    2>r net2o-sock 2r> 0 sockaddr> alen @ sendto +send 1 packets +!
    sendto( ." send to: " sockaddr> alen @ .address space dup . cr ) ;

\ clients routing table

: init-route ( -- )  s" " routes# hash@ $! ; \ field 0 is me, myself

: ipv4>ipv6 ( addr u -- addr' u' )
    drop >r
    r@ port be-uw@ sockaddr> port be-w!
    r> sin_addr be-ul@ sockaddr> ipv4!
    sockaddr> sock-rest ;
: ?>ipv6 ( addr u -- addr' u' )
    over family w@ AF_INET = IF  ipv4>ipv6  THEN ;
: info@ ( info -- addr u )
    dup ai_addr @ swap ai_addrlen l@ ;
: info>string ( info -- addr u )
    info@ ?>ipv6 ;

: insert-ip ( addr u port -- net2o-addr )  0         insert-ip* ;
: insert-ip4 ( addr u port -- net2o-addr ) PF_INET   insert-ip* ;
: insert-ip6 ( addr u port -- net2o-addr ) PF_INET6  insert-ip* ;

: route>address ( n -- flag )
    routes# #.key dup 0= ?EXIT
    $@ sockaddr> over alen ! sockaddr_in smove true ;

\ route an incoming packet

: >rpath-len ( rpath -- rpath len )
    dup 0= IF  0  EXIT  THEN
    [IFDEF] 64bit
	dup $100000000 u< IF