Check-in [70ffcaf06c]
Not logged in

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

Overview
Comment:bump version
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 70ffcaf06c3e5fa1655d4ac76143e152de991faf
User & Date: bernd 2020-01-16 16:06:27
Context
2020-01-17
15:00
Default perm is 644, min perm is 400 (read yourself) check-in: b36cd84a4e user: bernd tags: trunk
2020-01-16
16:06
bump version check-in: 70ffcaf06c user: bernd tags: trunk
2020-01-12
23:44
Hide neon based assembler code, as GCC's compilation is faster check-in: 5f8d5bcf9e user: bernd tags: trunk, 0.9.7-20200116
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to classes.fs.

259
260
261
262
263
264
265


266
267
268
269
270
271
272
    0 +field start-strings
    field: resend0
    field: data-resend
    field: pubkey        \ other side official pubkey
    field: rqd-xts       \ callbacks for request done (array)
    field: my-error-id
    field: beacon-hash


    0 +field end-strings
    field: dest-addrs    \ list of destinations
    field: punch-addrs   \ list of punch destinations
    field: request-gen   \ pre-generated request number
    field: perm-mask
    \ secrets
    0 +field start-secrets







>
>







259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
    0 +field start-strings
    field: resend0
    field: data-resend
    field: pubkey        \ other side official pubkey
    field: rqd-xts       \ callbacks for request done (array)
    field: my-error-id
    field: beacon-hash
    field: slurp#$       \ slurp id+num string
    field: spit#$        \ spit id+num string
    0 +field end-strings
    field: dest-addrs    \ list of destinations
    field: punch-addrs   \ list of punch destinations
    field: request-gen   \ pre-generated request number
    field: perm-mask
    \ secrets
    0 +field start-secrets

Changes to configure.ac.

11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
# 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/>.

AC_INIT([net2o], [0.9.6-20200109], [bernd@net2o.de], [net2o], [https://fossil.net2o.de/net2o/reportlist])
AC_PREREQ([2.59])
AC_CONFIG_MACRO_DIR([m4])
AC_USE_SYSTEM_EXTENSIONS
LT_INIT

AC_MSG_CHECKING([for gforth])








|







11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
# 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/>.

AC_INIT([net2o], [0.9.7-20200116], [bernd@net2o.de], [net2o], [https://fossil.net2o.de/net2o/reportlist])
AC_PREREQ([2.59])
AC_CONFIG_MACRO_DIR([m4])
AC_USE_SYSTEM_EXTENSIONS
LT_INIT

AC_MSG_CHECKING([for gforth])

Changes to connected.fs.

12
13
14
15
16
17
18


19
20
21
22
23
24
25
..
44
45
46
47
48
49
50

51
52
53





54
55
56
57
58
59
60
\ 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/>.

\ everything that follows here can assume to have a connection context



scope{ net2o-base

connect-table $@ inherit-table context-table

\ generic functions
\g 
................................................................................
    >r 64>n r> data-rmap with mapc
	over dest-top <> and false dest-end ?!@ drop \ atomic, replaces or!
	dest-top!
    endwith ;
+net2o: slurp ( -- ) \g slurp in tracked files
    \ !!FIXME!! this should probably be asynchronous
    net2o:slurp swap ulit, flag, set-top

    ['] do-track-seek net2o:track-all-seeks net2o:send-chunks ;
+net2o: ack-reset ( -- ) \g reset ack state
    0 ack-state c! ;






\ object handles
\g 
\g ### file commands ###
\g 

$30 net2o: file-id ( uid -- o:file ) \g choose a file object







>
>







 







>



>
>
>
>
>







12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
..
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
\ 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/>.

\ everything that follows here can assume to have a connection context

forward slurp,

scope{ net2o-base

connect-table $@ inherit-table context-table

\ generic functions
\g 
................................................................................
    >r 64>n r> data-rmap with mapc
	over dest-top <> and false dest-end ?!@ drop \ atomic, replaces or!
	dest-top!
    endwith ;
+net2o: slurp ( -- ) \g slurp in tracked files
    \ !!FIXME!! this should probably be asynchronous
    net2o:slurp swap ulit, flag, set-top
    slurp,
    ['] do-track-seek net2o:track-all-seeks net2o:send-chunks ;
+net2o: ack-reset ( -- ) \g reset ack state
    0 ack-state c! ;
+net2o: slurped ( $slurped -- ) \g respond to slurped stuff
    $> spit#$ $+! ;

in forth : slurp, ( -- )
    slurp#$ $@ $, slurped  slurp#$ $free ;

\ object handles
\g 
\g ### file commands ###
\g 

$30 net2o: file-id ( uid -- o:file ) \g choose a file object

Changes to file.fs.

360
361
362
363
364
365
366
367
368
369
370
371
372




373
374
375
376
377
378
379
...
381
382
383
384
385
386
387

388
389
390
391
392
393
394
...
431
432
433
434
435
436
437
438






439
440
441
442
443
444
445
446
447
448
: fstate-free ( -- )  file-state @ 0= ?EXIT
    [: fstates-free file-state $free ;] file-sema c-section ;
in net2o : save-block ( back tail id -- delta ) { id -- delta }
    data-rmap with mapc fix-size raddr+ endwith residualwrite @ umin
    id id>addr? .fs-write
    file1( id f-wid @ = IF  dup f-wamount +!
    ELSE  f-wid @ 0>= f-wamount @ 0> and IF
	    ." split: " f-wid @ . f-wamount @ hex. cr  THEN
        id f-wid ! dup f-wamount !  THEN )
    >blockalign dup negate residualwrite +! ;

\ careful: must follow exactly the same logic as slurp (see below)





in net2o : spit { back tail -- newback }
    back tail back u<= ?EXIT fstates 0= ?EXIT drop
    slurp( ." spit: " tail rdata-back@ drop data-rmap with mapc dest-raddr - endwith hex.
    write-file# ? residualwrite @ hex. forth:cr ) back tail
    [: +calc fstates 0 { back tail states fails }
	BEGIN  tail back u>  WHILE
		back tail write-file# @ net2o:save-block dup +to back
................................................................................
		residualwrite @ 0= IF
		    write-file# file+ blocksize @ residualwrite !  THEN
	    fails states u>= UNTIL
	THEN
	msg( ." Write end" cr ) +file
	back  fails states u>= IF  >maxalign  THEN  \ if all files are done, align
    ;] file-sema c-section

    slurp( ."  left: " tail rdata-back@ drop data-rmap with mapc dest-raddr - endwith hex.
    write-file# ? residualwrite @ hex. forth:cr ) ;

: save-to ( addr u n -- )  state-addr .fs-create ;
: save-to# ( addr u n -- )  state-addr >o  1 fs-class!  fs-create o> ;

\ file status stuff
................................................................................

: open-file ( addr u mode id -- )
    state-addr .fs-open ;

\ read in from files

: slurp-block { id -- delta }
    data-head@ id id>addr? .fs-read dup /head






    file1( id f-rid @ = IF  dup f-ramount +!
    ELSE  f-rid @ 0>=  f-ramount @ 0> and IF
	    ." split: " f-rid @ . f-ramount @ hex. cr  THEN
        id f-rid ! dup f-ramount !  THEN ) ;

\ careful: must follow exactpy the same logic as net2o:spit (see above)
: slurp ( -- head end-flag )
    data-head? 0= fstates 0= or  IF  head@ 0  EXIT  THEN
    slurp( ." slurp: " data-head@ drop data-map with mapc dest-raddr - endwith hex.
    read-file# ? residualread @ hex. forth:cr )







|





>
>
>
>







 







>







 







|
>
>
>
>
>
>


|







360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
...
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
...
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
: fstate-free ( -- )  file-state @ 0= ?EXIT
    [: fstates-free file-state $free ;] file-sema c-section ;
in net2o : save-block ( back tail id -- delta ) { id -- delta }
    data-rmap with mapc fix-size raddr+ endwith residualwrite @ umin
    id id>addr? .fs-write
    file1( id f-wid @ = IF  dup f-wamount +!
    ELSE  f-wid @ 0>= f-wamount @ 0> and IF
	    ." spit: " f-wid @ . f-wamount @ hex. cr  THEN
        id f-wid ! dup f-wamount !  THEN )
    >blockalign dup negate residualwrite +! ;

\ careful: must follow exactly the same logic as slurp (see below)

: .spit ( -- )
    spit#$ $@ 2dup dump
    bounds ?DO  I c@ hex. I 1+ p2@+ >r x64. cr r> I - +LOOP ;

in net2o : spit { back tail -- newback }
    back tail back u<= ?EXIT fstates 0= ?EXIT drop
    slurp( ." spit: " tail rdata-back@ drop data-rmap with mapc dest-raddr - endwith hex.
    write-file# ? residualwrite @ hex. forth:cr ) back tail
    [: +calc fstates 0 { back tail states fails }
	BEGIN  tail back u>  WHILE
		back tail write-file# @ net2o:save-block dup +to back
................................................................................
		residualwrite @ 0= IF
		    write-file# file+ blocksize @ residualwrite !  THEN
	    fails states u>= UNTIL
	THEN
	msg( ." Write end" cr ) +file
	back  fails states u>= IF  >maxalign  THEN  \ if all files are done, align
    ;] file-sema c-section
    slurp( .spit ) spit#$ $free
    slurp( ."  left: " tail rdata-back@ drop data-rmap with mapc dest-raddr - endwith hex.
    write-file# ? residualwrite @ hex. forth:cr ) ;

: save-to ( addr u n -- )  state-addr .fs-create ;
: save-to# ( addr u n -- )  state-addr >o  1 fs-class!  fs-create o> ;

\ file status stuff
................................................................................

: open-file ( addr u mode id -- )
    state-addr .fs-open ;

\ read in from files

: slurp-block { id -- delta }
    data-head@ id id>addr? .fs-read
    dup IF  id slurp#$ c$+! dup u>64 slurp#$ p2$+!
	dup >blockalign over - ?dup-IF
	    $FF slurp#$ c$+! u>64 slurp#$ p2$+!
	THEN
    THEN
    dup /head
    file1( id f-rid @ = IF  dup f-ramount +!
    ELSE  f-rid @ 0>=  f-ramount @ 0> and IF
	    ." slurp: " f-rid @ . f-ramount @ hex. cr  THEN
        id f-rid ! dup f-ramount !  THEN ) ;

\ careful: must follow exactpy the same logic as net2o:spit (see above)
: slurp ( -- head end-flag )
    data-head? 0= fstates 0= or  IF  head@ 0  EXIT  THEN
    slurp( ." slurp: " data-head@ drop data-map with mapc dest-raddr - endwith hex.
    read-file# ? residualread @ hex. forth:cr )

Changes to gui.fs.

396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411

: read-avatar ( addr u -- addr' u' )
    ?read-enc-hashed mem>thumb atlas-region ;
Variable user-avatar#
Variable dummy-thumb#
Variable user.png$
Variable thumb.png$
: ]path ( addr u -- )
    file>fpath ]] SLiteral [[ ] ;
: read-user.png ( -- )
    [ "doc/user.png" ]path user.png$ $slurp-file ;
: read-thumb.png ( -- )
    [ "minos2/thumb.png" ]path thumb.png$ $slurp-file ;
: user-avatar ( -- addr )
    user-avatar# @ 0= IF
	read-user.png user.png$ $@ mem>thumb atlas-region







<
<







396
397
398
399
400
401
402


403
404
405
406
407
408
409

: read-avatar ( addr u -- addr' u' )
    ?read-enc-hashed mem>thumb atlas-region ;
Variable user-avatar#
Variable dummy-thumb#
Variable user.png$
Variable thumb.png$


: read-user.png ( -- )
    [ "doc/user.png" ]path user.png$ $slurp-file ;
: read-thumb.png ( -- )
    [ "minos2/thumb.png" ]path thumb.png$ $slurp-file ;
: user-avatar ( -- addr )
    user-avatar# @ 0= IF
	read-user.png user.png$ $@ mem>thumb atlas-region

Changes to linux/notify.fs.

18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
..
74
75
76
77
78
79
80



81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101

102
103
104

105
106
107


108
109
110
111




112
113
114
115
116
117
118


119
: escape-<&> ( addr u -- )
    bounds ?DO  case i c@
	    '<' of  ." &lt;"   endof
	    '>' of  ." &gt;"   endof
	    '&' of  ." &amp;"  endof
	    '"' of  ." &quot;" endof
	    emit  0 endcase  LOOP ;
: escape-<&>-shell ( addr u -- )
    bounds ?DO  case i c@
	    '<' of  ." &lt;"   endof
	    '>' of  ." &gt;"   endof
	    '&' of  ." &amp;"  endof
	    '"' of  ." &quot;" endof
	    '\' of  ." \\"     endof
	    '$' of  ." \$"     endof
	    '!' of  ." \!"     endof
	    emit  0 endcase  LOOP ;
: escape-shell ( addr u -- )
    bounds ?DO  case i c@
	    '\' of  ." \\"     endof
	    '$' of  ." \$"     endof
	    '!' of  ." \!"     endof
	    emit  0 endcase  LOOP ;

: build-notification ( -- ) ;
: notify@ ( -- addr u )
    config:notify-text# @ IF
	notify-otr? @ config:notify-text# @ 0> and IF
	    "<i>[otr] message</i>"
	ELSE  notify$ $@ ['] escape-<&> $tmp  THEN
................................................................................
    upath $@ bounds ?DO I c@ ':' = IF 0 I c! THEN LOOP
    "notify-send" upath file>abspath notify-send $!
    upath $free ;

: !net2o-logo ( -- )
    s" ../doc/net2o-logo.png" fpath file>abspath net2o-logo $! ;




: ?free0 ( addr -- )
    dup 0= IF  drop  EXIT  THEN  @ free throw ;
: !notify-args ( -- )
    title-string   ?free0
    content-string ?free0
    here >r notify-args dp !
    "notify-send\0" drop ,
    "-a\0" drop ,
    "net2o\0" drop ,
    "-c\0" drop ,
    "im.received\0" drop ,
    net2o-logo $@len IF
	"-i\0" drop ,
	net2o-logo $@ drop ,
    THEN
    here to title-string 0 ,
    here to content-string 0 ,
    0 , \ must be terminated by null pointer
    r> dp ! ;

!upath !net2o-logo !notify-args


:noname defers 'cold
    !upath !net2o-logo !notify-args ; is 'cold


: linux-notification ( -- )  notify-send $@len 0= ?EXIT
    [IFDEF] use-execve


	notify@ content-string 0$!
	['] notify-title $tmp dup 0= IF  2drop  EXIT  THEN  title-string 0$!
	notify-send $@ notify-args fork+exec
    [ELSE]




	[: notify-send $. space
	    ." -a net2o -c im.received "
	    net2o-logo $@len IF
		." -i " net2o-logo $. space  THEN
	    ['] notify-title $tmp dup 0= IF  2drop  EXIT  THEN
	    '"' emit escape-<&>-shell '"' emit space
	    '"' emit notify@ escape-shell '"' emit ;] $tmp system


    [THEN] ;







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







 







>
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|

|
>


<
>



>
>




>
>
>
>




|
<
|
>
>

18
19
20
21
22
23
24
















25
26
27
28
29
30
31
..
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
88
89
90
91

92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110

111
112
113
114
: escape-<&> ( addr u -- )
    bounds ?DO  case i c@
	    '<' of  ." &lt;"   endof
	    '>' of  ." &gt;"   endof
	    '&' of  ." &amp;"  endof
	    '"' of  ." &quot;" endof
	    emit  0 endcase  LOOP ;

















: build-notification ( -- ) ;
: notify@ ( -- addr u )
    config:notify-text# @ IF
	notify-otr? @ config:notify-text# @ 0> and IF
	    "<i>[otr] message</i>"
	ELSE  notify$ $@ ['] escape-<&> $tmp  THEN
................................................................................
    upath $@ bounds ?DO I c@ ':' = IF 0 I c! THEN LOOP
    "notify-send" upath file>abspath notify-send $!
    upath $free ;

: !net2o-logo ( -- )
    s" ../doc/net2o-logo.png" fpath file>abspath net2o-logo $! ;

!upath !net2o-logo

[IFDEF] use-execve
    : ?free0 ( addr -- )
	dup 0= IF  drop  EXIT  THEN  @ free throw ;
    : !notify-args ( -- )
	title-string   ?free0
	content-string ?free0
	here >r notify-args dp !
	"notify-send\0" drop ,
	"-a\0" drop ,
	"net2o\0" drop ,
	"-c\0" drop ,
	"im.received\0" drop ,
	net2o-logo $@len IF
	    "-i\0" drop ,
	    net2o-logo $@ drop ,
	THEN
	here to title-string 0 ,
	here to content-string 0 ,
	0 , \ must be terminated by null pointer
	r> dp ! ;

    !notify-args
[THEN]

:noname defers 'cold

    !upath !net2o-logo [IFDEF] !notify-args !notify-args [THEN] ; is 'cold

: linux-notification ( -- )  notify-send $@len 0= ?EXIT
    [IFDEF] use-execve
	\ for now unknown reasons, notify-send doesn't like this way of
	\ being called
	notify@ content-string 0$!
	['] notify-title $tmp dup 0= IF  2drop  EXIT  THEN  title-string 0$!
	notify-send $@ notify-args fork+exec
    [ELSE]
	\ Use variables to avoid needing to quote stuff
	\ Unfortunately, HTML quoting still needed
	"TITLE" ['] notify-title $tmp ['] escape-<&> $tmp 1 setenv ?ior
	"MESSAGE" notify@ 1 setenv ?ior
	[: notify-send $. space
	    ." -a net2o -c im.received "
	    net2o-logo $@len IF
		." -i " net2o-logo $. space  THEN
	    .\" \"$TITLE\" \"$MESSAGE\""

	;] $tmp system
	"TITLE" unsetenv ?ior
	"MESSAGE" unsetenv ?ior
    [THEN] ;

Changes to msg.fs.

73
74
75
76
77
78
79

80
81
82
83
84
85
86
87
88
89
90
91








92
93
94
95
96
97
98
...
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
...
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
...
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
...
904
905
906
907
908
909
910















911
912
913
914
915
916
917
918
919
920
921
922
923

924
925
926
927
928
929
930
....
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
....
1625
1626
1627
1628
1629
1630
1631



1632
1633
1634
1635
1636
1637
1638
....
1754
1755
1756
1757
1758
1759
1760

1761
1762
1763
1764
1765
1766
1767
		    a[] over cells cell $del
		ELSE
		    1+
		THEN
	REPEAT  drop ;] msglog-sema c-section ;

forward msg-scan-hash

forward msg-serialize-hash

: serialize-log ( addr u -- $addr )
    [: [: bounds ?DO
		I $@ check-date 0= IF
		    2dup msg:display
		    net2o-base:$, net2o-base:nestsig
		ELSE   msg( ." removed entry " dump )else( 2drop )  THEN
	    cell +LOOP
	    msg-serialize-hash
	;] msg-scan-hash ;] gen-cmd ;









Variable saved-msg$
64Variable saved-msg-ticks

: save-msgs ( group-o -- ) to msg-group-o
    msg( ." Save messages in group " msg-group-o dup hex. .msg:name$ type cr )
    ?.net2o/chats  net2o:new-msging >o
    msg-log@ over >r  serialize-log enc-file $!buf
................................................................................
Forward msg:last?
Forward msg:last
Forward msg:want

hash: fetch-finish#
Variable fetch-queue[]

hash: ihave#

: .@host.id ( pk+host u -- )
    '@' emit
    2dup keysize2 safe/string type '.' emit
    key2| .simple-id ;
: .ihaves ( -- )
    ." ====== hash owend by ======" cr
    ihave# [: dup $@ 85type ." :"
	cell+ $@ bounds U+DO
	    space I $@ .@host.id
	cell +LOOP cr ;] #map ;

: msg:ihave ( id u1 hash u2 -- )
\    ." ihave:" 2over dump 2dup dump
    2dup ihave$ $+!  2over mehave$ $!
    bounds U+DO  2dup I keysize ihave# #!ins[]  keysize +LOOP  2drop ;
: pk.host ( -- addr u ) [: pk@ type host$ $. ;] $tmp ;
: >ihave ( hash u -- )
    pk.host 2swap  msg:ihave ;

: push-msg ( o:parent -- )
    up@ receiver-task <> IF
	avalanche-msg
................................................................................
: fetch-queue 0 .pk.host $make { tsk w^ want# w^ pk$ -- }
    want# tsk pk$ [{: tsk pk$ :}l { item }
	item $@ $8 $E pk-connect? IF  +resend +flow-control
	    { | hashs }
	    item cell+ $@ bounds U+DO
		net2o-code expect+slurp $10 blocksize! $A blockalign!
		I' I U+DO
		    I keysize ihave# $@ dup IF
			0 -rot bounds U+DO
			    I $@ pk$ $@ str= or
			cell +LOOP
		    ELSE  2drop true  THEN
		    IF
			I keysize net2o:copy#
			I keysize save-mem tsk [{: d: hash tsk :}h
................................................................................
    want# #frees
    pk$ $free ;

event: :>fetch-queue fetch-queue ;

: transmit-queue ( queue -- )
    { w^ queue[] | w^ want# }
    queue[] want# [{: want# :}l 2dup ihave# #@ dup IF
	    bounds U+DO
		2dup I $@ want# #+!
	    cell +LOOP  2drop
	ELSE  2drop 2drop  THEN ;] $[]map
    queue[] $[]free
    <event up@ elit, want# @ elit, :>fetch-queue ?query-task event> ;

................................................................................
:noname 2dup msg-dec?-sig? ; msg-class is nest-sig

' context-table is gen-table

also }scope

\ serialize hashes
















: msg-serialize-hash ( -- )
    0 .pk.host $make { w^ pk$ | w^ want# }
    ?hashs[] want# pk$ [{: want# pk$ :}l
	2dup need-hashed? 0= IF
	    pk$ $@ 2over ihave# #!ins[]
	    2dup pk$ $@ want# #+!
	THEN
	2dup ihave# #@ dup IF
	    bounds U+DO
		2dup I $@ want# #+!
	    cell +LOOP
	ELSE  2drop  THEN

	2drop
    ;] $[]map
    want# [:
	msg( dup $@ .@host.id ." : " dup cell+ $@ 85type forth:cr )
	dup cell+ $@ $, $@ $, msg-ihave ;] #map
    ?hashs[] $[]free
    want# #frees
................................................................................
$20 Value max-last#
$20 Value ask-last#

$8 Value max-want#
: have>want ( hashs u want# -- ) { want# }
    \ transform have into wants
    bounds U+DO
	I keysize ihave# #@ bounds U+DO
	    J keysize I $@ want# #+!
	cell +LOOP
    keysize +LOOP ;
: want, ( index -- )
    \ compile a single want
    over $@len over cell+ $@len + 8 + maxstring u< IF
	dup cell+ $@ $, $@ $, msg-ihave
................................................................................
    \G split: reduce distribution load by reconnecting
umethod /have ( addr u -- )
    \U have                 print out have list
    \G have: print out the hashes and their providers
umethod /imgs ( addr u -- )
    \U imgs                 print out img list
    \G imgs: print out hashes for album viewer



end-class chat-cmds

chat-cmds new Constant text-chat-cmd-o

text-chat-cmd-o to chat-cmd-o

' 2drop is /imgs \ stub
................................................................................
    2drop msg-group-o .msg:-lock
    [: net2o-base:msg-unlock ;] send-avalanche
; is /unlock
:noname ( addr u -- )
    2drop msg-group-o .msg:?lock 0= IF  ." un"  THEN  ." locked" forth:cr
; is /lock?
' .ihaves is /have


$100 buffer: permchar>bits
msg:role-admin# msg:key-admin# msg:moderator# or or 'a' permchar>bits + c!
msg:role-admin# 'r' permchar>bits + c!
msg:key-admin#  'k' permchar>bits + c!
msg:moderator#  'm' permchar>bits + c!
msg:troll#      't' permchar>bits + c!







>












>
>
>
>
>
>
>
>







 







|







|







|







 







|







 







|







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>




|
|
|
|
|
|
|
|
|
>







 







|







 







>
>
>







 







>







73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
...
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
...
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
...
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
...
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
....
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
....
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
....
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
		    a[] over cells cell $del
		ELSE
		    1+
		THEN
	REPEAT  drop ;] msglog-sema c-section ;

forward msg-scan-hash
forward msg-add-hashs
forward msg-serialize-hash

: serialize-log ( addr u -- $addr )
    [: [: bounds ?DO
		I $@ check-date 0= IF
		    2dup msg:display
		    net2o-base:$, net2o-base:nestsig
		ELSE   msg( ." removed entry " dump )else( 2drop )  THEN
	    cell +LOOP
	    msg-serialize-hash
	;] msg-scan-hash ;] gen-cmd ;

: scan-log-hashs ( -- )
    msg-log@ over >r
    [: bounds ?DO
	    I $@ msg:display
	cell +LOOP
	msg-add-hashs
    ;] msg-scan-hash r> free throw ;

Variable saved-msg$
64Variable saved-msg-ticks

: save-msgs ( group-o -- ) to msg-group-o
    msg( ." Save messages in group " msg-group-o dup hex. .msg:name$ type cr )
    ?.net2o/chats  net2o:new-msging >o
    msg-log@ over >r  serialize-log enc-file $!buf
................................................................................
Forward msg:last?
Forward msg:last
Forward msg:want

hash: fetch-finish#
Variable fetch-queue[]

hash: have#

: .@host.id ( pk+host u -- )
    '@' emit
    2dup keysize2 safe/string type '.' emit
    key2| .simple-id ;
: .ihaves ( -- )
    ." ====== hash owend by ======" cr
    have# [: dup $@ 85type ." :"
	cell+ $@ bounds U+DO
	    space I $@ .@host.id
	cell +LOOP cr ;] #map ;

: msg:ihave ( id u1 hash u2 -- )
\    ." ihave:" 2over dump 2dup dump
    2dup ihave$ $+!  2over mehave$ $!
    bounds U+DO  2dup I keysize have# #!ins[]  keysize +LOOP  2drop ;
: pk.host ( -- addr u ) [: pk@ type host$ $. ;] $tmp ;
: >ihave ( hash u -- )
    pk.host 2swap  msg:ihave ;

: push-msg ( o:parent -- )
    up@ receiver-task <> IF
	avalanche-msg
................................................................................
: fetch-queue 0 .pk.host $make { tsk w^ want# w^ pk$ -- }
    want# tsk pk$ [{: tsk pk$ :}l { item }
	item $@ $8 $E pk-connect? IF  +resend +flow-control
	    { | hashs }
	    item cell+ $@ bounds U+DO
		net2o-code expect+slurp $10 blocksize! $A blockalign!
		I' I U+DO
		    I keysize have# $@ dup IF
			0 -rot bounds U+DO
			    I $@ pk$ $@ str= or
			cell +LOOP
		    ELSE  2drop true  THEN
		    IF
			I keysize net2o:copy#
			I keysize save-mem tsk [{: d: hash tsk :}h
................................................................................
    want# #frees
    pk$ $free ;

event: :>fetch-queue fetch-queue ;

: transmit-queue ( queue -- )
    { w^ queue[] | w^ want# }
    queue[] want# [{: want# :}l 2dup have# #@ dup IF
	    bounds U+DO
		2dup I $@ want# #+!
	    cell +LOOP  2drop
	ELSE  2drop 2drop  THEN ;] $[]map
    queue[] $[]free
    <event up@ elit, want# @ elit, :>fetch-queue ?query-task event> ;

................................................................................
:noname 2dup msg-dec?-sig? ; msg-class is nest-sig

' context-table is gen-table

also }scope

\ serialize hashes

: ?ihave ( addr u pk$ want# -- ) { pk$ want# -- }
    2dup need-hashed? 0= IF
	pk$ $@ 2over have# #!ins[]
	2dup pk$ $@ want# #+!
    THEN ;
: msg-add-hashs ( -- )
    0 .pk.host $make { w^ pk$ }
    ?hashs[] pk$ [{: pk$ :}l
	2dup need-hashed? 0= IF
	    pk$ $@ 2over have# #!ins[]
	THEN  2drop
    ;] $[]map
    ?hashs[] $[]free
    pk$ $free ;

: msg-serialize-hash ( -- )
    0 .pk.host $make { w^ pk$ | w^ want# }
    ?hashs[] want# pk$ [{: want# pk$ :}l
	2dup have# #@ dup IF
	    false { flag }
	    bounds U+DO
		2dup I $@ want# #+!
		I $@ pk$ $@ str= +to flag
	    cell +LOOP
	    flag 0= IF  pk$ want# ?ihave  THEN
	ELSE
	    2drop  pk$ want# ?ihave
	THEN
	2drop
    ;] $[]map
    want# [:
	msg( dup $@ .@host.id ." : " dup cell+ $@ 85type forth:cr )
	dup cell+ $@ $, $@ $, msg-ihave ;] #map
    ?hashs[] $[]free
    want# #frees
................................................................................
$20 Value max-last#
$20 Value ask-last#

$8 Value max-want#
: have>want ( hashs u want# -- ) { want# }
    \ transform have into wants
    bounds U+DO
	I keysize have# #@ bounds U+DO
	    J keysize I $@ want# #+!
	cell +LOOP
    keysize +LOOP ;
: want, ( index -- )
    \ compile a single want
    over $@len over cell+ $@len + 8 + maxstring u< IF
	dup cell+ $@ $, $@ $, msg-ihave
................................................................................
    \G split: reduce distribution load by reconnecting
umethod /have ( addr u -- )
    \U have                 print out have list
    \G have: print out the hashes and their providers
umethod /imgs ( addr u -- )
    \U imgs                 print out img list
    \G imgs: print out hashes for album viewer
umethod /rescan# ( addr u -- )
    \U rescan#              rescan for hashes
    \G rescan#: search the entire chat log for hashes and if you have them
end-class chat-cmds

chat-cmds new Constant text-chat-cmd-o

text-chat-cmd-o to chat-cmd-o

' 2drop is /imgs \ stub
................................................................................
    2drop msg-group-o .msg:-lock
    [: net2o-base:msg-unlock ;] send-avalanche
; is /unlock
:noname ( addr u -- )
    2drop msg-group-o .msg:?lock 0= IF  ." un"  THEN  ." locked" forth:cr
; is /lock?
' .ihaves is /have
' scan-log-hashs is /rescan#

$100 buffer: permchar>bits
msg:role-admin# msg:key-admin# msg:moderator# or or 'a' permchar>bits + c!
msg:role-admin# 'r' permchar>bits + c!
msg:key-admin#  'k' permchar>bits + c!
msg:moderator#  'm' permchar>bits + c!
msg:troll#      't' permchar>bits + c!

Deleted shlibs/keccak.

1
../keccak
<


Changes to tools.fs.

232
233
234
235
236
237
238























239
240
241
242
243
244
245
...
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
    64dup 64-0< n>64 64swap 64-2* 64xor ;

: ps!+ ( 64n addr -- addr' )
    >r n>zz r> p!+ ;
: ps@+ ( addr -- 64n addr' )
    p@+ >r zz>n r> ;
























\ bit reversing

: bitreverse8 ( u1 -- u2 )
    0 8 0 DO  2* over 1 and + swap 2/ swap  LOOP  nip ;

Create reverse-table $100 0 [DO] [I] bitreverse8 c, [LOOP]

................................................................................
#10.000.000.000. savedelta& 2! \ 10 seconds deltat
#3600.000.000.000. ekey-timeout& 2! \ one hour ekey timeout
#60.000.000.000. dht-cleaninterval& 2! \ one minute dht clean interval
#50.000.000.000. beacon-ticks& 2!
#2.000.000.000. beacon-short-ticks& 2!

: ]path ( addr u -- )
    open-fpath-file throw rot close-file throw ] ]] sliteral [[ ;

: .net2o-config/ ( addr u -- addr' u' ) [: .net2o-config$ $. '/' emit type ;] $tmp ;
: .net2o-cache/ ( addr u -- addr' u' ) [: .net2o-cache$ $. '/' emit type ;] $tmp ;
: ~net2o-cache/ ( addr u -- )
    .net2o-cache/ 2dup $1FF init-dir drop set-dir throw ;
: ~net2o-cache/.. ( addr u -- )
    .net2o-cache/ 2dup $1FF init-dir drop dirname set-dir throw ;







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







|







232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
...
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
    64dup 64-0< n>64 64swap 64-2* 64xor ;

: ps!+ ( 64n addr -- addr' )
    >r n>zz r> p!+ ;
: ps@+ ( addr -- 64n addr' )
    p@+ >r zz>n r> ;

\ compact representation of mostly power-of-two numbers

: p2@+ ( addr -- 64bit addr' )
    count >r r@ $C0 u>= IF
	64#1 r> $3F and 64lshift n64-swap  EXIT  THEN
    r@ $0F and u>64 r> 4 rshift 8 umin 0 ?DO
	8 64lshift 64>r count u>64 64r> 64+
    LOOP  n64-swap ;
: p2$+! ( 64bit addr -- )
    >r
    64dup $F u>64 64u> IF
	64dup 64dup 64#1 64- 64and 64-0= IF
	    64>f fdup f* { | w^ ff1 }
	    ff1 sf! ff1 [ 3 pad ! pad c@ ]L + c@ $3F - $C0 or
	    r> c$+!  EXIT  THEN
	THEN
    0 >r <#
    BEGIN   64dup $F u>64 64u>  WHILE
	    64dup 64>n $FF and hold 8 64rshift
	    r> $10 + >r
    REPEAT
    64>n r> or hold #0. #> r> $+! ;

\ bit reversing

: bitreverse8 ( u1 -- u2 )
    0 8 0 DO  2* over 1 and + swap 2/ swap  LOOP  nip ;

Create reverse-table $100 0 [DO] [I] bitreverse8 c, [LOOP]

................................................................................
#10.000.000.000. savedelta& 2! \ 10 seconds deltat
#3600.000.000.000. ekey-timeout& 2! \ one hour ekey timeout
#60.000.000.000. dht-cleaninterval& 2! \ one minute dht clean interval
#50.000.000.000. beacon-ticks& 2!
#2.000.000.000. beacon-short-ticks& 2!

: ]path ( addr u -- )
    file>fpath ]] SLiteral [[ ] ;

: .net2o-config/ ( addr u -- addr' u' ) [: .net2o-config$ $. '/' emit type ;] $tmp ;
: .net2o-cache/ ( addr u -- addr' u' ) [: .net2o-cache$ $. '/' emit type ;] $tmp ;
: ~net2o-cache/ ( addr u -- )
    .net2o-cache/ 2dup $1FF init-dir drop set-dir throw ;
: ~net2o-cache/.. ( addr u -- )
    .net2o-cache/ 2dup $1FF init-dir drop dirname set-dir throw ;

Changes to wiki/commands.md.

165
166
167
168
169
170
171


172
173
174
175
176
177
178
  close all files
* $2B set-top ( utop flag -- )
  set top, flag is true when all data is sent
* $2C slurp ( -- )
  slurp in tracked files
* $2D ack-reset ( -- )
  reset ack state



### file commands ###

* $30 file-id ( uid -- o:file )
  choose a file object
* $20 open-file ( $:string mode -- )
  open file with mode







>
>







165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
  close all files
* $2B set-top ( utop flag -- )
  set top, flag is true when all data is sent
* $2C slurp ( -- )
  slurp in tracked files
* $2D ack-reset ( -- )
  reset ack state
* $2E slurped ( $slurped -- )
  respond to slurped stuff

### file commands ###

* $30 file-id ( uid -- o:file )
  choose a file object
* $20 open-file ( $:string mode -- )
  open file with mode