Verified Commit d3a3d69e authored by Bernd Paysan's avatar Bernd Paysan
Browse files

Separate in and out sockaddr 

Make sure leaving a group gives the left message to everyone
parent 9a9be086

classes.fs

+2 −1
Original line number Original line Diff line number Diff line
@@ -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

hash-table.fs

+1 −1
Original line number Original line Diff line number Diff line
@@ -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 -- ... )

helper.fs

+9 −9
Original line number Original line Diff line number Diff line
@@ -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 ;

ip.fs

+10 −10
Original line number Original line Diff line number Diff line
@@ -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$ 
    : '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$ 
[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 




: 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

msg.fs

+12 −16
Original line number Original line Diff line number Diff line
@@ -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 
: >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 




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 
	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 -- ) 
    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 




: 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