Commit d3a3d69e authored by Bernd Paysan's avatar Bernd Paysan

Separate in and out sockaddr

Make sure leaving a group gives the left message to everyone
parent 9a9be086
...@@ -381,7 +381,8 @@ user-o io-mem ...@@ -381,7 +381,8 @@ user-o io-mem
object class object class
pollfd 4 * uvar pollfds \ up to four file descriptors pollfd 4 * uvar pollfds \ up to four file descriptors
sockaddr_in uvar sockaddr sockaddr_in uvar sockaddr< \ incoming socket
sockaddr_in uvar sockaddr> \ outgoing socket
sockaddr_in uvar sockaddr1 sockaddr_in uvar sockaddr1
[IFDEF] no-hybrid [IFDEF] no-hybrid
sockaddr_in uvar sockaddr2 sockaddr_in uvar sockaddr2
......
...@@ -113,7 +113,7 @@ warnings ! ...@@ -113,7 +113,7 @@ warnings !
hash 0= IF drop 0 EXIT THEN hash 0= IF drop 0 EXIT THEN
$100 um* dup $80 and WHILE $100 um* dup $80 and WHILE
$80 + cells hash + @ to hash $80 + cells hash + @ to hash
REPEAT REPEAT \ stack: pathlow pathhigh (<=$7F)
nip 2* cells hash + ; nip 2* cells hash + ;
: #map { hash xt -- } \ xt: ( ... node -- ... ) : #map { hash xt -- } \ xt: ( ... node -- ... )
......
...@@ -191,26 +191,26 @@ Variable my-beacon ...@@ -191,26 +191,26 @@ Variable my-beacon
THEN THEN
THEN 2drop THEN 2drop
net2o-sock net2o-sock
sockaddr alen @ routes# #@ dup 0= IF 2drop "!" THEN sockaddr< alen @ routes# #@ dup 0= IF 2drop "!" THEN
beacon( ticks .ticks ." Send '" 2dup type ." ' reply to: " sockaddr alen @ .address forth:cr ) beacon( ticks .ticks ." Send '" 2dup type ." ' reply to: " sockaddr< alen @ .address forth:cr )
0 sockaddr alen @ sendto drop +send ; 0 sockaddr< alen @ sendto drop +send ;
: !-beacon ( addr u -- ) 2drop : !-beacon ( addr u -- ) 2drop
\G I got a reply, my address is unknown \G I got a reply, my address is unknown
beacon( ticks .ticks ." Got unknown reply: " sockaddr alen @ .address forth:cr ) beacon( ticks .ticks ." Got unknown reply: " sockaddr< alen @ .address forth:cr )
sockaddr alen @ beacons #@ d0<> IF last# do-beacon THEN ; sockaddr< alen @ beacons #@ d0<> IF last# do-beacon THEN ;
: .-beacon ( addr u -- ) 2drop : .-beacon ( addr u -- ) 2drop
\G I got a reply, my address is known \G I got a reply, my address is known
beacon( ticks .ticks ." Got known reply: " sockaddr alen @ .address forth:cr ) beacon( ticks .ticks ." Got known reply: " sockaddr< alen @ .address forth:cr )
sockaddr alen @ beacons #@ IF sockaddr< alen @ beacons #@ IF
>r r@ 64@ ticks 64umin beacon-ticks# 64+ r> 64! >r r@ 64@ ticks 64umin beacon-ticks# 64+ r> 64!
THEN ; THEN ;
: >-beacon ( addr u -- ) : >-beacon ( addr u -- )
\G I got a punch \G I got a punch
nat( ticks .ticks ." Got punch: " sockaddr alen @ .address forth:cr ) nat( ticks .ticks ." Got punch: " sockaddr< alen @ .address forth:cr )
check-punch-hash ?dup-IF check-punch-hash ?dup-IF
\ !!FIXME!! accept only two: one IPv4, one IPv6. \ !!FIXME!! accept only two: one IPv4, one IPv6.
\ !!FIXME!! and try merging the two into existent \ !!FIXME!! and try merging the two into existent
>o sockaddr alen @ nat( ." +punch " 2dup .address forth:cr ) >o sockaddr< alen @ nat( ." +punch " 2dup .address forth:cr )
.sockaddr new-addr punch-addrs >stack o> .sockaddr new-addr punch-addrs >stack o>
THEN ; THEN ;
......
...@@ -33,7 +33,7 @@ Create fake-ip4 $0000 w, $0000 w, $0000 w, $0000 w, $0000 w, $FFFF w, ...@@ -33,7 +33,7 @@ Create fake-ip4 $0000 w, $0000 w, $0000 w, $0000 w, $0000 w, $FFFF w,
Create nat64-ip4 $0064 w, $ff9b w, $0000 w, $0000 w, $0000 w, $0000 w, Create nat64-ip4 $0064 w, $ff9b w, $0000 w, $0000 w, $0000 w, $0000 w,
\ prefix for IPv4 addresses via NAT64 \ prefix for IPv4 addresses via NAT64
: >alen ( addr u -- alen ) : >alen ( addr -- alen )
sockaddr_in6 sockaddr_in4 rot family w@ AF_INET6 = select ; sockaddr_in6 sockaddr_in4 rot family w@ AF_INET6 = select ;
\ convention: \ convention:
...@@ -176,9 +176,9 @@ Forward .addr$ ...@@ -176,9 +176,9 @@ Forward .addr$
: 'sock4 ( xt -- ) sock4[ catch ]sock4 throw ; : 'sock4 ( xt -- ) sock4[ catch ]sock4 throw ;
: check-ip4 ( ip4addr -- my-ip4addr 4 ) ipv4( : check-ip4 ( ip4addr -- my-ip4addr 4 ) ipv4(
[: sockaddr_in4 alen ! 53 sockaddr port be-w! [: sockaddr_in4 alen ! 53 sockaddr< port be-w!
sockaddr sin_addr be-l! query-sock sockaddr< sin_addr be-l! query-sock
sockaddr sock-rest4 connect sockaddr< sock-rest4 connect
dup unavail? IF drop ip6::0 4 EXIT THEN ?ior dup unavail? IF drop ip6::0 4 EXIT THEN ?ior
query-sock sockaddr1 alen getsockname query-sock sockaddr1 alen getsockname
dup unavail? IF drop ip6::0 4 EXIT THEN ?ior dup unavail? IF drop ip6::0 4 EXIT THEN ?ior
...@@ -188,9 +188,9 @@ Forward .addr$ ...@@ -188,9 +188,9 @@ Forward .addr$
[ELSE] [ELSE]
: check-ip4 ( ip4addr -- my-ip4addr 4 ) ipv4( : check-ip4 ( ip4addr -- my-ip4addr 4 ) ipv4(
[: ipv6( sockaddr_in6 )else( sockaddr_in4 ) alen ! [: ipv6( sockaddr_in6 )else( sockaddr_in4 ) alen !
53 sockaddr port be-w! 53 sockaddr< port be-w!
sockaddr ipv4! query-sock sockaddr< ipv4! query-sock
sockaddr ipv6( sock-rest )else( sock-rest4 ) connect sockaddr< ipv6( sock-rest )else( sock-rest4 ) connect
dup unavail? IF drop ip6::0 4 EXIT THEN ?ior dup unavail? IF drop ip6::0 4 EXIT THEN ?ior
query-sock sockaddr1 alen getsockname query-sock sockaddr1 alen getsockname
dup unavail? IF drop ip6::0 4 EXIT THEN ?ior dup unavail? IF drop ip6::0 4 EXIT THEN ?ior
...@@ -213,9 +213,9 @@ $FD c, $00 c, $0000 w, $0000 w, $0000 w, $0000 w, $0000 w, $0000 w, $00 c, $01 c ...@@ -213,9 +213,9 @@ $FD c, $00 c, $0000 w, $0000 w, $0000 w, $0000 w, $0000 w, $0000 w, $00 c, $01 c
: check-ip6 ( dummy -- ip6addr u ) ipv6( : check-ip6 ( dummy -- ip6addr u ) ipv6(
\G return IPv6 address - if length is 0, not reachable with IPv6 \G return IPv6 address - if length is 0, not reachable with IPv6
[: sockaddr_in6 alen ! 53 sockaddr port be-w! [: sockaddr_in6 alen ! 53 sockaddr< port be-w!
sockaddr sin6_addr ip6! sockaddr< sin6_addr ip6!
query-sock sockaddr sock-rest connect query-sock sockaddr< sock-rest connect
dup unavail? IF drop ip6::0 $10 EXIT THEN ?ior dup unavail? IF drop ip6::0 $10 EXIT THEN ?ior
query-sock sockaddr1 alen getsockname query-sock sockaddr1 alen getsockname
dup unavail? IF drop ip6::0 $10 EXIT THEN ?ior dup unavail? IF drop ip6::0 $10 EXIT THEN ?ior
......
...@@ -135,12 +135,13 @@ event: :>load-msg ( last# -- ) ...@@ -135,12 +135,13 @@ event: :>load-msg ( last# -- )
: ?msg-log ( addr u -- ) msg-logs ?hash ; : ?msg-log ( addr u -- ) msg-logs ?hash ;
0 Value log# 0 Value log#
2Variable last-msg
: +msg-log ( addr u -- addr' u' / 0 0 ) : +msg-log ( addr u -- addr' u' / 0 0 )
last# $@ ?msg-log last# $@ ?msg-log
[: last# cell+ $ins[]date dup to log# [: last# cell+ $ins[]date dup to log#
dup -1 = IF drop #0. ( 0 to last# ) ELSE last# cell+ $[]@ THEN dup -1 = IF drop #0. ( 0 to last# ) ELSE last# cell+ $[]@ THEN
;] msglog-sema c-section ; ;] msglog-sema c-section 2dup last-msg 2! ;
: ?save-msg ( addr u -- ) : ?save-msg ( addr u -- )
?msg-log ?msg-log
last# otr-mode @ replay-mode @ or 0= and last# otr-mode @ replay-mode @ or 0= and
...@@ -160,12 +161,6 @@ Sema queue-sema ...@@ -160,12 +161,6 @@ Sema queue-sema
: >msg-log ( addr u -- addr' u ) : >msg-log ( addr u -- addr' u )
last# >r +msg-log last# ?dup-IF $@ ?save-msg THEN r> to last# ; last# >r +msg-log last# ?dup-IF $@ ?save-msg THEN r> to last# ;
Variable otr-log
: >otr-log ( addr u -- addr' u )
[: otr-log $ins[]date
dup -1 = IF drop #0. ELSE otr-log $[]@ THEN
;] msglog-sema c-section ;
: do-msg-nestsig ( addr u -- ) : do-msg-nestsig ( addr u -- )
parent .msg-context @ .msg:display msg-notify ; parent .msg-context @ .msg:display msg-notify ;
...@@ -218,19 +213,19 @@ Forward +chat-control ...@@ -218,19 +213,19 @@ Forward +chat-control
User peer-buf User peer-buf
: reconnect-chat ( $chat -- ) : reconnect-chat ( addr u $chat -- )
peer-buf $!buf last# peer-buf $@ peer-buf $!buf last# peer-buf $@
reconnect( ." reconnect " 2dup 2dup + 1- c@ 1+ - .addr$ cr ) reconnect( ." reconnect " 2dup 2dup + 1- c@ 1+ - .addr$ cr )
reconnect( ." in group: " last# dup hex. $. cr ) reconnect( ." in group: " last# dup hex. $. cr )
0 >o $A $A [: reconnect( ." prepare reconnection" cr ) 0 >o $A $A [: reconnect( ." prepare reconnection" cr )
?msg-context >o silent-last# ! o> ?msg-context >o silent-last# ! o>
['] chat-rqd-nat ['] chat-rqd-nonat ind-addr @ select rqd! ;] ['] chat-rqd-nat ['] chat-rqd-nonat ind-addr @ select rqd! ;]
addr-connect o> ; addr-connect 2dup d0= IF 2drop ELSE avalanche-to THEN o> ;
event: :>avalanche ( addr u o group -- ) event: :>avalanche ( addr u o group -- )
avalanche( ." Avalanche to: " dup hex. cr ) avalanche( ." Avalanche to: " dup hex. cr )
to last# .avalanche-msg ; to last# .avalanche-msg ;
event: :>chat-reconnect ( $chat o group -- ) event: :>chat-reconnect ( addr u $chat o group -- )
to last# .reconnect-chat ; to last# .reconnect-chat ;
event: :>msg-nestsig ( $addr o group -- ) event: :>msg-nestsig ( $addr o group -- )
to last# >o { w^ m } m $@ do-msg-nestsig m $free o> to last# >o { w^ m } m $@ do-msg-nestsig m $free o>
...@@ -590,7 +585,7 @@ $21 net2o: msg-group ( $:group -- ) \g set group ...@@ -590,7 +585,7 @@ $21 net2o: msg-group ( $:group -- ) \g set group
parent last# cell+ del$cell THEN ; parent last# cell+ del$cell THEN ;
+net2o: msg-reconnect ( $:pubkey+addr -- ) \g rewire distribution tree +net2o: msg-reconnect ( $:pubkey+addr -- ) \g rewire distribution tree
$> $make $> $make
<event elit, o elit, last# elit, :>chat-reconnect <event last-msg 2@ e$, elit, o elit, last# elit, :>chat-reconnect
parent .wait-task @ ?query-task over select event> ; parent .wait-task @ ?query-task over select event> ;
+net2o: msg-last? ( start end n -- ) 64>n msg:last? ; +net2o: msg-last? ( start end n -- ) 64>n msg:last? ;
+net2o: msg-last ( $:[tick0,msgs,..tickn] n -- ) 64>n msg:last ; +net2o: msg-last ( $:[tick0,msgs,..tickn] n -- ) 64>n msg:last ;
...@@ -821,8 +816,6 @@ event: :>msg-eval ( parent $pack $addr -- ) ...@@ -821,8 +816,6 @@ event: :>msg-eval ( parent $pack $addr -- )
now>otr ]pksign ; now>otr ]pksign ;
: msg-log, ( -- addr u ) : msg-log, ( -- addr u )
last-signed 2@ >msg-log ; last-signed 2@ >msg-log ;
: otr-log, ( -- addr u )
last-signed 2@ >otr-log ;
previous previous
...@@ -1501,13 +1494,16 @@ also net2o-base ...@@ -1501,13 +1494,16 @@ also net2o-base
: send-reconnects ( group o:connection -- ) o to connection : send-reconnects ( group o:connection -- ) o to connection
net2o-code expect-msg net2o-code expect-msg
[: dup $@ ?destpk 2dup >group $, msg-leave reconnects, [: dup $@ ?destpk 2dup >group $, msg-leave
sign[ msg-start "left" $, msg-action msg-otr> ;] [msg,] sign[ msg-start "left" $, msg-action msg-otr>
reconnects, ;] [msg,]
end-code| ; end-code| ;
: send-reconnect1 ( o o:connection -- ) o to connection : send-reconnect1 ( o o:connection -- ) o to connection
net2o-code expect-msg net2o-code expect-msg
[: last# $@ $, msg-group .reconnect, ;] [msg,] [: last# $@ $, msg-leave
sign[ msg-start "left" $, msg-action msg-otr>
.reconnect, ;] [msg,]
end-code| ; end-code| ;
previous previous
......
...@@ -1390,12 +1390,12 @@ Forward handle-beacon ...@@ -1390,12 +1390,12 @@ Forward handle-beacon
Forward handle-beacon+hash Forward handle-beacon+hash
: add-source ( -- ) : add-source ( -- )
sockaddr alen @ insert-address inbuf ins-source ; sockaddr< alen @ insert-address inbuf ins-source ;
: next-packet ( -- addr u ) : next-packet ( -- addr u )
sender-task 0= IF send-read-packet ELSE try-read-packet-wait THEN sender-task 0= IF send-read-packet ELSE try-read-packet-wait THEN
dup minpacket# u>= IF dup minpacket# u>= IF
( nat( ." packet from: " sockaddr alen @ .address cr ) ( nat( ." packet from: " sockaddr< alen @ .address cr )
over packet-size over <> over packet-size over <>
header( ~~ !!size!! )else( IF 2drop 0 0 EXIT !!size!! THEN ) header( ~~ !!size!! )else( IF 2drop 0 0 EXIT !!size!! THEN )
+next +next
...@@ -1518,7 +1518,7 @@ Forward cmd-exec ( addr u -- ) ...@@ -1518,7 +1518,7 @@ Forward cmd-exec ( addr u -- )
User remote? User remote?
: handle-cmd0 ( -- ) \ handle packet to address 0 : handle-cmd0 ( -- ) \ handle packet to address 0
cmd0( .time ." handle cmd0 " sockaddr alen @ .address cr ) cmd0( .time ." handle cmd0 " sockaddr< alen @ .address cr )
0 >o rdrop remote? on \ address 0 has no job context! 0 >o rdrop remote? on \ address 0 has no job context!
inbuf0-decrypt 0= IF inbuf0-decrypt 0= IF
invalid( ." invalid packet to 0" cr ) EXIT THEN invalid( ." invalid packet to 0" cr ) EXIT THEN
...@@ -1581,10 +1581,11 @@ scope{ mapc ...@@ -1581,10 +1581,11 @@ scope{ mapc
: route-packet ( -- ) : route-packet ( -- )
add-source add-source
inbuf >r r@ get-dest route>address IF inbuf >r r@ get-dest route>address IF
route( ." route to: " sockaddr alen @ .address space route( ." route to: " sockaddr> alen @ .address space
inbuf destination .addr-path cr ) inbuf destination .addr-path cr )
r@ dup packet-size send-a-packet 0< r@ dup packet-size send-a-packet 0<
IF ." failed to send to: " sockaddr alen @ .address cr true ?ior THEN IF ." failed to send from: " sockaddr< dup >alen .address
." to: " sockaddr> alen @ .address cr true ?ior THEN
THEN rdrop ; THEN rdrop ;
\ dispose context \ dispose context
...@@ -1736,7 +1737,7 @@ Variable need-beacon# need-beacon# on \ true if needs a hash for the ? beacon ...@@ -1736,7 +1737,7 @@ Variable need-beacon# need-beacon# on \ true if needs a hash for the ? beacon
: add-beacon ( net2oaddr xt -- ) : add-beacon ( net2oaddr xt -- )
>r route>address IF >r route>address IF
sockaddr alen @ r@ +beacon sockaddr> alen @ r@ +beacon
o IF o IF
s" ?" beacon-hash $! gen-beacon-hash beacon-hash $+! s" ?" beacon-hash $! gen-beacon-hash beacon-hash $+!
THEN THEN
......
...@@ -60,24 +60,24 @@ $00000000 Value rec-droprate# ...@@ -60,24 +60,24 @@ $00000000 Value rec-droprate#
: read-a-packet ( blockage -- addr u / 0 0 ) : read-a-packet ( blockage -- addr u / 0 0 )
>r sockaddr_in alen ! >r sockaddr_in alen !
net2o-sock [IFDEF] no-hybrid drop [THEN] net2o-sock [IFDEF] no-hybrid drop [THEN]
inbuf maxpacket r> sockaddr alen recvfrom inbuf maxpacket r> sockaddr< alen recvfrom
dup 0< IF dup 0< IF
errno dup EAGAIN = IF 2drop #0. EXIT THEN errno dup EAGAIN = IF 2drop #0. EXIT THEN
#512 + negate throw THEN #512 + negate throw THEN
inbuf swap 1 packetr +! ?drop-inc inbuf swap 1 packetr +! ?drop-inc
recvfrom( ." received from: " sockaddr alen @ .address space dup . cr ) recvfrom( ." received from: " sockaddr< alen @ .address space dup . cr )
; ;
[IFDEF] no-hybrid [IFDEF] no-hybrid
: read-a-packet4 ( blockage -- addr u / 0 0 ) : read-a-packet4 ( blockage -- addr u / 0 0 )
>r sockaddr_in alen ! >r sockaddr_in alen !
net2o-sock nip net2o-sock nip
inbuf maxpacket r> sockaddr alen recvfrom inbuf maxpacket r> sockaddr< alen recvfrom
dup 0< IF dup 0< IF
errno dup EAGAIN = IF 2drop #0. EXIT THEN errno dup EAGAIN = IF 2drop #0. EXIT THEN
THEN THEN
inbuf swap 1 packetr +! ?drop-inc inbuf swap 1 packetr +! ?drop-inc
recvfrom( ." received from: " sockaddr alen @ .address space dup . cr ) recvfrom( ." received from: " sockaddr< alen @ .address space dup . cr )
; ;
[THEN] [THEN]
...@@ -101,8 +101,8 @@ $00000000 Value droprate# ...@@ -101,8 +101,8 @@ $00000000 Value droprate#
droprate# IF rng32 droprate# u< IF droprate# IF rng32 droprate# u< IF
resend( ." dropping packet" cr ) resend( ." dropping packet" cr )
1 packets +! 2drop 0 EXIT THEN THEN 1 packets +! 2drop 0 EXIT THEN THEN
2>r net2o-sock 2r> 0 sockaddr alen @ sendto +send 1 packets +! 2>r net2o-sock 2r> 0 sockaddr> alen @ sendto +send 1 packets +!
sendto( ." send to: " sockaddr alen @ .address space dup . cr ) ; sendto( ." send to: " sockaddr> alen @ .address space dup . cr ) ;
\ clients routing table \ clients routing table
...@@ -110,9 +110,9 @@ $00000000 Value droprate# ...@@ -110,9 +110,9 @@ $00000000 Value droprate#
: ipv4>ipv6 ( addr u -- addr' u' ) : ipv4>ipv6 ( addr u -- addr' u' )
drop >r drop >r
r@ port be-uw@ sockaddr port be-w! r@ port be-uw@ sockaddr> port be-w!
r> sin_addr be-ul@ sockaddr ipv4! r> sin_addr be-ul@ sockaddr> ipv4!
sockaddr sock-rest ; sockaddr> sock-rest ;
: ?>ipv6 ( addr u -- addr' u' ) : ?>ipv6 ( addr u -- addr' u' )
over family w@ AF_INET = IF ipv4>ipv6 THEN ; over family w@ AF_INET = IF ipv4>ipv6 THEN ;
: info@ ( info -- addr u ) : info@ ( info -- addr u )
...@@ -162,7 +162,7 @@ Variable lastn2oaddr ...@@ -162,7 +162,7 @@ Variable lastn2oaddr
: route>address ( n -- flag ) : route>address ( n -- flag )
routes# #.key dup 0= ?EXIT routes# #.key dup 0= ?EXIT
$@ sockaddr swap dup alen ! move true ; $@ sockaddr> over alen ! sockaddr_in smove true ;
\ route an incoming packet \ route an incoming packet
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment