Check-in [b8150dd265]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Separate in and out sockaddr Make sure leaving a group gives the left message to everyone
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: b8150dd2657d07f43152e9a4670b36197b2ce6ba
User & Date: bernd 2018-06-15 13:01:28
Context
2018-06-16
22:10
Prepare for /sync working in GUI mode check-in: 2d7dda9f10 user: bernd tags: trunk
2018-06-15
13:01
Separate in and out sockaddr Make sure leaving a group gives the left message to everyone check-in: b8150dd265 user: bernd tags: trunk
2018-06-13
21:10
Bump version number check-in: b8b04ec18b user: bernd tags: trunk, 0.7.2-20180613
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to classes.fs.

377
378
379
380
381
382
383
384

385
386
387
388
389
390
391

\ io per-task variables

user-o io-mem

object class
    pollfd 4 *      uvar pollfds \ up to four file descriptors
    sockaddr_in     uvar sockaddr

    sockaddr_in     uvar sockaddr1
    [IFDEF] no-hybrid
	sockaddr_in uvar sockaddr2
    [THEN]
    file-stat       uvar statbuf
    aligned
    cell            uvar ind-addr







|
>







377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392

\ 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

Changes to hash-table.fs.

109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
    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
    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







|







109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
    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

Changes to helper.fs.

187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
    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







|
|
|


|
|


|
|




|



|







187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
    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

Changes to ip.fs.

29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
...
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
...
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
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 u -- 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(







|







 







|
|
|









|
|
|







 







|
|
|







29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
...
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
...
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
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(

Changes to msg.fs.

131
132
133
134
135
136
137

138
139
140
141
142
143
144
145
146
147
148
149
150
...
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
...
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
...
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
...
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
....
1497
1498
1499
1500
1501
1502
1503
1504
1505

1506
1507
1508
1509


1510
1511
1512
1513
1514
1515
1516
1517

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

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

0 Value log#


: +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 ;
: ?save-msg ( addr u -- )
    ?msg-log
    last# otr-mode @ replay-mode @ or 0= and
    IF  save-msgs&  THEN ;

Sema queue-sema

................................................................................
    [: 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# ;

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 -- )
    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 ( $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 o> ;

event: :>avalanche ( addr u o group -- )
    avalanche( ." Avalanche to: " dup hex. cr )
    to last# .avalanche-msg ;
event: :>chat-reconnect ( $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 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 ;
: otr-log, ( -- addr u )
    last-signed 2@ >otr-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  reconnects,
      sign[ msg-start "left" $, msg-action msg-otr> ;] [msg,]

    end-code| ;

: send-reconnect1 ( o o:connection -- ) o to connection
    net2o-code expect-msg


    [: last# $@ $, msg-group .reconnect, ;] [msg,]
    end-code| ;
previous

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







>





|







 







<
<
<
<
<
<







 







|






|




|







 







|







 







<
<







 







|
|
>




>
>
|







131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
...
157
158
159
160
161
162
163






164
165
166
167
168
169
170
...
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
...
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
...
812
813
814
815
816
817
818


819
820
821
822
823
824
825
....
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513

: 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

................................................................................
    [: 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

Changes to net2o.fs.

1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
....
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
....
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586

1587
1588
1589
1590
1591
1592
1593
1594
....
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
    [:  \ ." 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 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







|




|







 







|







 







|


>
|







 







|







1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
....
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
....
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
....
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
    [:  \ ." 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

Changes to socks.fs.

56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
..
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
...
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
    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 swap dup alen ! move true ;

\ route an incoming packet

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







|




|






|




|







 







|
|







|
|
|







 







|







56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
..
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
...
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
    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