Check-in [2326543d3a]
Not logged in

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

Overview
Comment:Replace msg-logs by msg:log[]
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 2326543d3ad938bb63bc099a3f314e4beae74972
User & Date: bernd 2019-06-20 22:13:20
Context
2019-06-21
12:43
More fixes for chat structure check-in: 557d941bc0 user: bernd tags: trunk
2019-06-20
22:13
Replace msg-logs by msg:log[] check-in: 2326543d3a user: bernd tags: trunk
19:45
/sync bug fixed check-in: 35e82dc6d7 user: bernd tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to cmd.fs.

705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
    IF  own-crypt-val do-nest  ELSE
	<err> ." cmdnest: no owncrypt, un-cmd" <default> forth:cr
	un-cmd  THEN ;

: cmdtmpnest ( addr u -- )
    $>align tmpkey@ key| dup IF
	key( ." tmpnest key: " 2dup 85type forth:cr ) decrypt$
	IF    tmp-crypt-val do-nest
	ELSE
	    <err> ." tmpnest failed, uncmd" <default> forth:cr
	    net2o:see-me 2drop un-cmd  THEN
    ELSE  2drop 2drop un-cmd  THEN ;
: cmdencnest ( addr u -- )
    $>align tmpkey@ dup IF
	key( ." encnest key: " 2dup 85type forth:cr ) decrypt$
	IF    enc-crypt-val do-nest  [ qr-tmp-val invert ]L validated and!
	ELSE <err> ." encnest failed, uncmd" <default> forth:cr
	    2drop un-cmd  THEN
    ELSE  <err> ." encnest: no tmpkey" <default> forth:cr







|
<
|
|
|







705
706
707
708
709
710
711
712

713
714
715
716
717
718
719
720
721
722
    IF  own-crypt-val do-nest  ELSE
	<err> ." cmdnest: no owncrypt, un-cmd" <default> forth:cr
	un-cmd  THEN ;

: cmdtmpnest ( addr u -- )
    $>align tmpkey@ key| dup IF
	key( ." tmpnest key: " 2dup 85type forth:cr ) decrypt$
	IF    tmp-crypt-val do-nest  EXIT  THEN

	cmd( <err> ." tmpnest failed, uncmd" <default> forth:cr
	net2o:see-me )
    ELSE  2drop  THEN  2drop un-cmd ;
: cmdencnest ( addr u -- )
    $>align tmpkey@ dup IF
	key( ." encnest key: " 2dup 85type forth:cr ) decrypt$
	IF    enc-crypt-val do-nest  [ qr-tmp-val invert ]L validated and!
	ELSE <err> ." encnest failed, uncmd" <default> forth:cr
	    2drop un-cmd  THEN
    ELSE  <err> ." encnest: no tmpkey" <default> forth:cr

Changes to dvcs.fs.

609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
...
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
...
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
...
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
' drop dvcs-log-class is msg:redisplay

: chat>dvcs ( o:dvcs -- )
    project:project$ $@ @/ 2drop load-msg ;
: .hash ( addr -- )
    [: dup $@ 85type ."  -> " cell+ $@ 85type cr ;] #map ;
: chat>branches-loop ( o:commit -- )
    last# msg-log@ over { log } bounds ?DO
	re$ $free  object$ $free
	I $@ ['] msg:display catch IF  ." invalid entry" cr 2drop THEN
    cell +LOOP  log free throw
    dvcs( ." === id>patch ===" cr id>patch# .hash
    ." === id>snap ===" cr id>snap# .hash ) ;
: chat>branches ( o:dvcs -- )
    project:project$ $@ @/ 2drop ?msg-log  dvcs:commits @ .chat>branches-loop ;

: >branches ( addr u -- )
    $make branches[] >back ;
User id-check# \ check hash
: id>branches-loop ( addr u -- )
    BEGIN  2dup id-check# #@ d0<> IF  2drop  EXIT  THEN
	s" !" 2over id-check# #!
................................................................................
: dispose-dvcs-log ( o:log -- )
    clear-log dispose ;
}scope

: display-logn ( addr u n -- )
    project:branch$ $@ { d: branch }
    dvcs:new-dvcs-log >o
    cells >r ?msg-log  last# msg-log@ 2dup { log u }
    dup r> - 0 max dup >r /string r> cell/ -rot bounds ?DO
	dvcs:clear-log  I $@ ['] msg:display catch
	IF  ." invalid entry" cr 2drop
	ELSE
	    branch dvcs-log:tag$ $@ str= IF
		dup 0 .r ." : [" dvcs-log:id$ $@ 85type ." ] "
		dvcs-log:sig$ $@ 2dup startdate@ .ticks
................................................................................

: dvcs-co ( addr u -- ) \ checkout revision
    base85>$  dvcs:new-dvcs >o
    config>dvcs   dvcs:id$ $! dvcs:id$  dvcs-readin  co-rest
    dvcs:dispose-dvcs o> ;

: chat>searchs-loop ( o:commit -- )
    last# msg-log@ over { log } bounds ?DO
	I $@ ['] msg:display catch IF  ." invalid entry" cr 2drop THEN
    cell +LOOP  log free throw ;
: search-last-rev ( -- addr u )
    project:project$ $@ @/ 2drop ?msg-log
    project:branch$ $@
    dvcs:searchs @ >o match:tag$ $!
    chat>searchs-loop match:id$ $@ o> ;

: dvcs-up ( -- ) \ checkout latest revision
    dvcs:new-dvcs >o
    pull-readin  files>dvcs  new>dvcs  dvcs?modified
................................................................................
	    THEN
\	    ELSE  end-code  THEN
	/sync-files +LOOP
    /sync-reqs +LOOP ;

: dvcs-data-sync ( -- )
    sync-file-list[] $[]off  branches[] $[]off
    msg-group$ $@ ?msg-log
    dvcs:commits @ .chat>branches-loop
    dvcs:commits @ .dvcs-needed-files
    sync-file-list[] $[]# 0> connection and
    IF    sync-file-list[] connection .get-needed-files  THEN ;

: dvcs-ref-sync ( -- )
    search-last-rev id>branches







|






|







 







|







 







|



|







 







|







609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
...
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
...
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
...
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
' drop dvcs-log-class is msg:redisplay

: chat>dvcs ( o:dvcs -- )
    project:project$ $@ @/ 2drop load-msg ;
: .hash ( addr -- )
    [: dup $@ 85type ."  -> " cell+ $@ 85type cr ;] #map ;
: chat>branches-loop ( o:commit -- )
    msg-log@ over { log } bounds ?DO
	re$ $free  object$ $free
	I $@ ['] msg:display catch IF  ." invalid entry" cr 2drop THEN
    cell +LOOP  log free throw
    dvcs( ." === id>patch ===" cr id>patch# .hash
    ." === id>snap ===" cr id>snap# .hash ) ;
: chat>branches ( o:dvcs -- )
    project:project$ $@ @/ 2drop >group  dvcs:commits @ .chat>branches-loop ;

: >branches ( addr u -- )
    $make branches[] >back ;
User id-check# \ check hash
: id>branches-loop ( addr u -- )
    BEGIN  2dup id-check# #@ d0<> IF  2drop  EXIT  THEN
	s" !" 2over id-check# #!
................................................................................
: dispose-dvcs-log ( o:log -- )
    clear-log dispose ;
}scope

: display-logn ( addr u n -- )
    project:branch$ $@ { d: branch }
    dvcs:new-dvcs-log >o
    cells >r >group  msg-log@ 2dup { log u }
    dup r> - 0 max dup >r /string r> cell/ -rot bounds ?DO
	dvcs:clear-log  I $@ ['] msg:display catch
	IF  ." invalid entry" cr 2drop
	ELSE
	    branch dvcs-log:tag$ $@ str= IF
		dup 0 .r ." : [" dvcs-log:id$ $@ 85type ." ] "
		dvcs-log:sig$ $@ 2dup startdate@ .ticks
................................................................................

: dvcs-co ( addr u -- ) \ checkout revision
    base85>$  dvcs:new-dvcs >o
    config>dvcs   dvcs:id$ $! dvcs:id$  dvcs-readin  co-rest
    dvcs:dispose-dvcs o> ;

: chat>searchs-loop ( o:commit -- )
    msg-log@ over { log } bounds ?DO
	I $@ ['] msg:display catch IF  ." invalid entry" cr 2drop THEN
    cell +LOOP  log free throw ;
: search-last-rev ( -- addr u )
    project:project$ $@ @/ 2drop >group
    project:branch$ $@
    dvcs:searchs @ >o match:tag$ $!
    chat>searchs-loop match:id$ $@ o> ;

: dvcs-up ( -- ) \ checkout latest revision
    dvcs:new-dvcs >o
    pull-readin  files>dvcs  new>dvcs  dvcs?modified
................................................................................
	    THEN
\	    ELSE  end-code  THEN
	/sync-files +LOOP
    /sync-reqs +LOOP ;

: dvcs-data-sync ( -- )
    sync-file-list[] $[]off  branches[] $[]off
    msg-group$ $@ >group
    dvcs:commits @ .chat>branches-loop
    dvcs:commits @ .dvcs-needed-files
    sync-file-list[] $[]# 0> connection and
    IF    sync-file-list[] connection .get-needed-files  THEN ;

: dvcs-ref-sync ( -- )
    search-last-rev id>branches

Changes to msg.fs.

28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
..
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
..
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
...
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
...
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
...
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
...
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
...
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
...
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
...
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
...
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
...
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
...
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
...
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
....
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
....
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
....
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183

1184
1185
1186
1187
1188
1189
1190
1191
....
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
....
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
....
1428
1429
1430
1431
1432
1433
1434

1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
....
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
....
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
....
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
    2dup msg-group# #@ d0= IF
	net2o:new-msg >o 2dup to msg:name$ o o>
	cell- [ msg-class >osize @ cell+ ]L
	2over msg-group# #!
    THEN  last# cell+ $@ drop cell+ to msg-group-o
    2drop ;

also msg

: avalanche-msg ( msg u1 o:connect -- )
    \G forward message to all next nodes of that message group
    { d: msg }
    msg-group-o .peers[] $@
    bounds ?DO  I @ o <> IF  msg I @ .avalanche-to  THEN
    cell +LOOP ;

previous

Variable msg-group$
Variable msg-logs
Variable otr-mode
Variable chain-mode
Variable redate-mode
Variable lock-mode
Variable msg-keys[]
User replay-mode
User skip-sig?
................................................................................
    msging-context @ dup 0= IF
	drop
	net2o:new-msging dup msging-context !
    THEN ;

: >chatid ( group u -- id u )  defaultkey sec@ keyed-hash#128 ;

: msg-log@ ( last# -- addr u )
    [: cell+ $@ save-mem ;] msglog-sema c-section ;

: purge-log ( -- )
    [: last# cell+ { a[] }
	0  BEGIN  dup a[] $[]# u<  WHILE
		dup a[] $[]@ check-date nip nip IF
		    dup a[] $[] $free
		    a[] over cells cell $del
		ELSE
		    1+
		THEN
................................................................................
	    ELSE   2drop  THEN
      cell +LOOP ;]
    gen-cmd ;

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

: save-msgs ( last -- )
    msg( ." Save messages" cr )
    ?.net2o/chats  net2o:new-msging >o
    dup msg-log@ over >r  serialize-log enc-file $!buf
    r> free throw  dispose o>
    $@ >chatid .chats/ enc-filename $!
    pk-off  key-list encfile-rest ;

: save-all-msgs ( -- )
    saved-msg$ $@ bounds ?DO  I @ save-msgs  cell +LOOP
    saved-msg$ $free ;

: save-msgs? ( -- )
................................................................................
	\ try read backup instead
	[: enc-filename $. '~' emit ;] $tmp ['] decrypt@ catch
	?dup-IF  DoError 2drop
	ELSE  msg-eval  THEN
    ELSE  msg-eval  THEN
    replay-mode off  skip-sig? off  enc-file $free ;

event: :>save-msgs ( last# -- ) saved-msg$ +unique$ ;
event: :>save-all-msgs ( -- )
    save-all-msgs ;
event: :>load-msg ( last# -- )
    $@ load-msg ;

: >load-group ( group u -- )
    2dup msg-logs #@ d0= >r >group r>
    IF  <event last# elit, :>load-msg
	parent .wait-task @
	dup 0= IF  drop ?file-task  THEN  event>  THEN ;

: !save-all-msgs ( -- )
    syncfile( save-all-msgs )else(
    <event :>save-all-msgs ?file-task event| ) ;

: save-msgs& ( -- )
    syncfile( last# saved-msg$ +unique$ )else(
    <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  dup 0< xor to log#
	log# last# cell+ $[]@ last-msg 2!
	0< IF  #0.  ELSE  last-msg 2@  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

\ peer queue, in msg context

: peer> ( -- addr / 0 )
    [: msg:peers[] back> ;] queue-sema c-section ;
................................................................................
    last# >r +msg-log last# ?dup-IF  $@ ?save-msg  THEN  r> to last# ;

: do-msg-nestsig ( addr u -- )
    2dup msg-group-o .msg:display
    msg-notify-o .msg:display ;

: display-lastn ( n -- )
    msg-group-o >o msg:redisplay o> ;
: display-sync-done ( -- )
    rows  msg-group-o .msg:redisplay ;

: display-one-msg { d: msgt -- }
    msg-group-o >o
    msgt ['] msg:display catch IF  ." invalid entry"  cr  2drop  THEN
    o> ;
................................................................................
    parent dup IF  .wait-task @ dup up@ <> and  THEN
    ?dup-IF
	>r r@ <hide> <event $make elit, o elit, last# elit, :>msg-nestsig
	r> event>
    ELSE  do-msg-nestsig  THEN ;

: date>i ( date -- i )
    last# cell+ $search[]date last# cell+ $[]# 1- umin ;
: date>i' ( date -- i )
    last# cell+ $search[]date last# cell+ $[]# umin ;
: sighash? ( addr u -- flag )
    over le-64@ date>i
    dup 0< IF  drop 2drop  false  EXIT  THEN  >r
    over le-64@ 64#1 64+ date>i' >r [ 1 64s ]L /string
    r> r> U+DO
	c:0key I last# cell+ $[]@ sigonly@ >hash
	2dup hashtmp over str= IF  2drop true  UNLOOP   EXIT
	ELSE  ( 2dup 85type ."  <> " hashtmp over 85type )  THEN
    LOOP
    2drop false ;

: msg-key! ( addr u -- )
    0 msg-keys[] [: rot >r 2over str= r> or ;] $[]map
................................................................................
:noname ( addr u -- ) $utf8>
    <warn> '#' forth:emit .group <default> ; msg-class is msg:tag
:noname ( addr u -- ) last# >r
    key| 2dup 0 .pk@ key| str=
    IF   <err>  THEN ." @" .key-id? <default>
    r> to last# ; msg-class is msg:signal
:noname ( addr u -- )
    last# >r last# $@ ?msg-log
    2dup sighash? IF  <info>  ELSE  <err>  THEN
    ."  <" over le-64@ .ticks
    verbose( dup keysize - /string ." ," 85type )else( 2drop ) <default>
    r> to last# ; msg-class is msg:chain
:noname ( addr u -- )
    space <warn> ." [" 85type ." ]->" <default> ; msg-class is msg:re
:noname ( addr u -- )
................................................................................
    2dup pk-sig? !!sig!! 2drop addrmsg umsg smove ;
: new-otrsig ( addr u -- addrsig usig )
    2dup startdate@ old>otr
    c:0key sigpksize# - c:hash ['] .sig $tmp 1 64s /string ;

:noname { sig u' addr u -- }
    u' 64'+ u =  u sigsize# = and IF
	last# >r last# $@ ?msg-log
	addr u startdate@ 64dup date>i >r 64#1 64+ date>i' r>
	2dup = IF  ."  [otrified] "  addr u startdate@ .ticks  THEN
	U+DO
	    I last# cell+ $[]@
	    2dup dup sigpksize# - /string key| msg:id$ str= IF
		dup u - /string addr u str= IF
		    ."  OTRify #" I u.
		    sig u' I last# cell+ $[]@ replace-sig
		    save-msgs&
		ELSE
		    ."  [OTRified] #" I u.
		THEN
	    ELSE
		2drop
	    THEN
................................................................................
: expect-msg ( o:connection -- )
    reply( ['] msg-reply )else( ['] drop ) expect-reply-xt +chat-control ;

User hashtmp$  hashtmp$ off

: last-msg@ ( -- ticks )
    last# >r
    last# $@ ?msg-log last# cell+ $[]# ?dup-IF
	1- last# cell+ $[]@ startdate@
    ELSE  64#0  THEN   r> to last# ;
: l.hashs ( end start -- hashaddr u )
    hashtmp$ $off
    last# cell+ $[]# IF
	[: U+DO  I last# cell+ $[]@ 1- dup 1 64s - safe/string forth:type
	  LOOP ;] hashtmp$ $exec hashtmp$ $@
	\ [: 2dup dump ;] stderr outfile-execute \ dump hash inputs
    ELSE  2drop s" "  THEN \ we have nothing yet
    >file-hash 1 64s umin ;
: i.date ( i -- )
    last# cell+ $[]@ startdate@ 64#0 { 64^ x }
    x le-64! x 1 64s forth:type ;
: i.date+1 ( i -- )
    last# cell+ $[]@ startdate@ 64#0 { 64^ x }
    64#1 64+ x le-64! x 1 64s forth:type ;
: last-msgs@ ( startdate enddate n -- addr u n' )
    \G print n intervals for messages from startdate to enddate
    \G The intervals contain the same size of messages except the
    \G last one, which may contain less (rounding down).
    \G Each interval contains a 64 bit hash of the last 64 bit of
    \G each message within the interval
    last# >r >r last# $@ ?msg-log purge-log
    last# cell+ $[]#
    IF
	date>i' >r date>i' r> swap
	2dup - r> over >r 1- 1 max / 0 max 1+ -rot
	[: over >r U+DO  I i.date
	      dup I + I' umin I l.hashs forth:type
	  dup +LOOP
	  r> dup last# cell+ $[]# u< IF  i.date
	  ELSE  1- i.date+1  THEN
	  drop ;] $tmp r> \ over 1 64s u> -
    ELSE  rdrop 64drop 64drop s" "  0 THEN   r> to last# ;

\ sync chatlog through virtual file access

termserver-class class
................................................................................

: msg:last? ( start end n -- )
    last# $@ $, msg-group
    max-last# umin
    last-msgs@ >r $, r> ulit, msg-last ;
: ?ask-msg-files ( addr u -- )
    64#-1 64#0 { 64^ startd 64^ endd } \ byte order of 0 and -1 don't matter
    last# $@ ?msg-log
    $> bounds ?DO
	I' I 64'+ u> IF
	    I le-64@ date>i'
	    I 64'+ 64'+ le-64@ date>i' swap
	    l.hashs drop le-64@
	    I 64'+ le-64@ 64<> IF
		I 64@ startd le-64@ 64umin
................................................................................
	parent .sync-none-xt \ sync-nothing-xt???
    THEN
    r> to last# ;

:noname ( -- 64len )
    \ poll serializes the 
    fs-outbuf $off
    fs-path $@ 2 64s /string ?msg-log
    last# msg-log@ over >r
    fs-path $@ drop le-64@ date>i \ start index
    fs-path $@ drop 64'+ le-64@ 64#1 64+ date>i' \ end index
    over - >r
    cells safe/string r> cells umin
    req? @ >r req? off  serialize-log   r> req? !  fs-outbuf $!buf
    r> free throw
    fs-outbuf $@len u>64 ; msgfs-class is fs-poll
................................................................................
    fs-close drop fs-path $!  fs-poll fs-size!
    ['] noop is file-xt
; msgfs-class is fs-open

\ syncing done
: chat-sync-done ( group-addr u -- )
    msg( ." chat-sync-done " 2dup forth:type forth:cr )
    ?msg-log display-sync-done !save-all-msgs
    net2o-code expect-msg close-all net2o:gen-reset end-code
    net2o:close-all
    ." === sync done ===" forth:cr sync-done-xt ;
event: :>msg-eval ( parent $pack $addr -- )
    { w^ buf w^ group }
    group $@ 2 64s /string { d: gname }
    gname ?msg-log
    gname msg-logs #@ nip cell/ u.
    buf $@ true replay-mode ['] msg-eval !wrapper
    buf $free gname ?save-msg
    group $@ .chat-file ."  saved "
    gname msg-logs #@ nip cell/ u. forth:cr
    >o -1 file-count +!@ 1 =
    IF  gname chat-sync-done  THEN  group $free
    o> ;
: msg-file-done ( -- )
    fs-path $@len IF
	msg( ." msg file done: " fs-path $@ .chat-file forth:cr )
	['] fs-flush file-sema c-section
................................................................................

previous

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

: last-signdate@ ( -- 64date )
    msg-group$ $@ msg-logs #@ dup IF
	+ cell- $@ startdate@ 64#1 64+
    ELSE  2drop 64#-1  THEN ;

also net2o-base
: [msg,] ( xt -- )  last# >r
    msg-group$ $@ dup IF  message ?destpk 2dup >group $,
	execute  end-with
................................................................................
    last-signdate@ 64#1 64+ lit, 64#-1 lit, ask-last# ulit, msg-last? ;

: join, ( -- )
    [: msg-join sync-ahead?,
      sign[ msg-start "joined" $, msg-action msg-otr> ;] [msg,] ;

: silent-join, ( -- )
    last# $@ dup IF  message $, msg-join  end-with
    ELSE  2drop  THEN ;

: leave, ( -- )
    [: msg-leave
      sign[ msg-start "left" $, msg-action msg-otr> ;] [msg,] ;

: silent-leave, ( -- )
................................................................................
: msg-tdisplay ( addr u -- )
    sigpksize# - 2dup + sigpksize# >$  c-state off
    nest-cmd-loop msg:end ;
' msg-tdisplay msg-class is msg:display
' msg-tdisplay msg-notify-class is msg:display
: msg-tredisplay ( n -- )
    reset-time  0 otr-mode
    [:  cells >r last# msg-log@ 2dup { log u }
	dup r> - 0 max /string bounds ?DO
	    I log - cell/ to log#
	    I $@ { d: msgt }
	    msgt ['] msg:display catch IF  ." invalid entry" cr
		2drop  THEN
	cell +LOOP
	log free throw ;] !wrapper ;
................................................................................

64Variable line-date 64#-1 line-date 64!
Variable $lastline

: !date ( addr u -- addr u )
    2dup + sigsize# - le-64@ line-date 64! ;
: find-prev-chatline { maxlen addr -- max span addr span }
    msg-group$ $@ ?msg-log
    last# cell+ $[]# 0= IF  maxlen 0 addr over  EXIT  THEN
    line-date 64@ date>i'
    BEGIN  1- dup 0>= WHILE  dup last# cell+ $[]@
	dup sigpksize# - /string key| pk@ key| str=  UNTIL  THEN
    last# cell+ $[]@ dup 0= IF  nip
    ELSE  !date ['] msg:display textmsg-o .$tmp 
	dup maxlen u> IF  dup >r maxlen 0 addr over r> grow-tib
	    2drop to addr drop to maxlen  THEN
	tuck addr maxlen smove
    THEN
    maxlen swap addr over ;
: find-next-chatline { maxlen addr -- max span addr span }
    msg-group$ $@ ?msg-log
    line-date 64@ date>i
    BEGIN  1+ dup last# cell+ $[]# u< WHILE  dup last# cell+ $[]@
	dup sigpksize# - /string key| pk@ key| str=  UNTIL  THEN
    dup last# cell+ $[]# u>=
    IF    drop $lastline $@  64#-1 line-date 64!
    ELSE  last# cell+ $[]@ !date ['] msg:display textmsg-o .$tmp  THEN
    dup maxlen u> IF  dup >r maxlen 0 addr over r> grow-tib
	2drop to addr drop to maxlen  THEN
    tuck addr maxlen smove
    maxlen swap addr over ;

: chat-prev-line  ( max span addr pos1 -- max span addr pos2 false )
    line-date 64@ 64#-1 64= IF
................................................................................
also net2o-base
\ chain messages to one previous message
: chain, ( msgaddr u -- )
    [: 2dup startdate@ 64#0 { 64^ sd } sd le-64!  sd 1 64s forth:type
	c:0key sigonly@ >hash hashtmp hash#128 forth:type ;] $tmp $, msg-chain ;

: ?chain, ( -- )  chain-mode @ 0= ?EXIT
    last# >r last# $@ ?msg-log
    last# cell+ $[]# 1- dup 0< IF  drop
    ELSE  last# cell+ $[]@ chain,

    THEN  r> to last# ;

: (send-avalanche) ( xt -- addr u flag )
    [: 0 >o [: sign[ msg-start execute ?chain, msg> ;] gen-cmd$ o>
      +last-signed msg-log, ;] [group] ;
previous
: send-avalanche ( xt -- )
    otr-mode @ IF  now>otr  ELSE  now>never  THEN
................................................................................
    ['] nick>chat arg-loop ;

\ do otrify

also net2o-base

: do-otrify ( n -- ) >r
    msg-group$ $@ ?msg-log last# cell+ $@ r> cells safe/string
    IF  $@ 2dup + sigpksize# - sigpksize#
	over keysize pkc over str= IF
	    keysize /string 2swap new-otrsig 2swap
	    $, $, msg-otrify
	ELSE
	    2drop 2drop ." not your message!" forth:cr
	THEN
................................................................................

: /chats ( addr u -- ) 2drop ." ===== chats: "
    \U chats                list chats
    \G chats: list all chats
    [:  msg:name$ msg-group$ $@ str= IF ." *" THEN
	msg:name$ .group
	." [" msg:peers[] $[]# 0 .r ." ]#"
	msg:name$ msg-logs #@ nip cell/ u. ;] group#map
    ." =====" forth:cr ;

: /nat ( addr u -- )  2drop
    \U nat                  list NAT info
    \G nat: list nat traversal information of all peers in all groups
    \U renat                redo NAT traversal
    \G renat: redo nat traversal
................................................................................
    \U n2o <cmd>            execute n2o command
    \G n2o: Execute normal n2o command

: /sync ( addr u -- )
    \U sync [+date] [-date] synchronize logs
    \G sync: synchronize chat logs, starting and/or ending at specific
    \G sync: time/date

    msg-group-o .msg:peers[] $@ 0= IF  drop  EXIT  THEN
    @ >o o to connection
    ." === sync ===" forth:cr
    net2o-code expect-msg [: msg-group last?, ;] [msg,] end-code o> ;

: /version ( addr u -- )
    \U version              version string
    \G version: print version string
    2drop .n2o-version space .gforth-version forth:cr ;

: /log ( addr u -- )
    \U log [#lines]         show log
    \G log: show the log, default is a screenful
    s>unumber? IF  drop >r  ELSE  2drop rows >r  THEN
    msg-group$ $@ ?msg-log purge-log
    r>  display-lastn ;

: /logstyle ( addr u -- )
    \U logstyle [+-style]   set log style
    \G logstyle: set log styles, the following settings exist:
    \G logstyle: +date      a date per log line
    \G logstyle: +num       a message number per log line
................................................................................

: avalanche-text ( addr u -- ) >utf8$
    [: parse-text ;] send-avalanche ;

previous

: load-msgn ( addr u n -- )
    >r 2dup load-msg ?msg-log r> display-lastn ;

: +group ( -- ) msg-group$ $@ >group +unique-con ;

: msg-timeout ( -- )
    packets2 @  connected-timeout  packets2 @ <>
    IF  reply( ." Resend to " pubkey $@ key>nick type cr )
	timeout-expired? IF
................................................................................
      ELSE  nip nip  THEN ;] $[]map ;

: key>group ( addr u -- pk u )
    @/ 2swap tuck msg-group$ $!  0=
    IF  2dup key| msg-group$ $!  THEN ; \ 1:1 chat-group=key

: ?load-msgn ( -- )
    msg-group$ $@ msg-logs #@ d0= IF
	msg-group$ $@ rows load-msgn  THEN ;

: chat-connects ( -- )
    chat-keys [: key>group ?load-msgn
      dup 0= IF  2drop msg-group$ $@ >group  EXIT  THEN
      2dup search-connect ?dup-IF  >o +group greet o> 2drop EXIT  THEN
      2dup pk-peek?  IF  chat-connect  ELSE  2drop  THEN ;] $[]map ;
................................................................................
    REPEAT  2drop leave-chats  xchar-history
    nr> set-order ;

: avalanche-to ( addr u o:context -- )
    avalanche( ." Send avalanche to: " pubkey $@ key>nick type space over hex. cr )
    o to connection
    net2o-code expect-msg message
    last# $@ 2dup pubkey $@ key| str= IF  2drop  ELSE  group,  THEN
    $, nestsig end-with
    end-code ;

\\\
Local Variables:
forth-local-words:
    (







<
<


|
|
|


<
<

<







 







|
|


|







 







|


|

|







 







|


|
|


|
|









|
<
<





<
|
|



|
|
<







 







|







 







|

|





|







 







|







 







|



|



|







 







|
|



|
|





|


|







|
|






|







 







|







 







|
|







 







|






|
|



|







 







|







 







|







 







|







 







|
|

|

|







|

|

|

|







 







<
|
<
>
|







 







|







 







|







 







>
|
|












|







 







|







 







|







 







|







28
29
30
31
32
33
34


35
36
37
38
39
40
41


42

43
44
45
46
47
48
49
..
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
..
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
...
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139


140
141
142
143
144

145
146
147
148
149
150
151

152
153
154
155
156
157
158
...
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
...
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
...
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
...
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
...
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
...
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
...
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
...
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
...
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
...
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
....
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
....
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
....
1165
1166
1167
1168
1169
1170
1171

1172

1173
1174
1175
1176
1177
1178
1179
1180
1181
....
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
....
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
....
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
....
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
....
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
....
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
    2dup msg-group# #@ d0= IF
	net2o:new-msg >o 2dup to msg:name$ o o>
	cell- [ msg-class >osize @ cell+ ]L
	2over msg-group# #!
    THEN  last# cell+ $@ drop cell+ to msg-group-o
    2drop ;



: avalanche-msg ( msg u1 o:connect -- )
    \G forward message to all next nodes of that message group
    { d: msgx }
    msg-group-o .msg:peers[] $@
    bounds ?DO  I @ o <> IF  msgx I @ .avalanche-to  THEN
    cell +LOOP ;



Variable msg-group$

Variable otr-mode
Variable chain-mode
Variable redate-mode
Variable lock-mode
Variable msg-keys[]
User replay-mode
User skip-sig?
................................................................................
    msging-context @ dup 0= IF
	drop
	net2o:new-msging dup msging-context !
    THEN ;

: >chatid ( group u -- id u )  defaultkey sec@ keyed-hash#128 ;

: msg-log@ ( -- addr u )
    [: msg-group-o .msg:log[] $@ save-mem ;] msglog-sema c-section ;

: purge-log ( -- )
    [: msg-group-o .msg:log[] { a[] }
	0  BEGIN  dup a[] $[]# u<  WHILE
		dup a[] $[]@ check-date nip nip IF
		    dup a[] $[] $free
		    a[] over cells cell $del
		ELSE
		    1+
		THEN
................................................................................
	    ELSE   2drop  THEN
      cell +LOOP ;]
    gen-cmd ;

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

: save-msgs ( group-o -- ) to msg-group-o
    msg( ." Save messages" cr )
    ?.net2o/chats  net2o:new-msging >o
    msg-log@ over >r  serialize-log enc-file $!buf
    r> free throw  dispose o>
    msg-group-o .msg:name$ >chatid .chats/ enc-filename $!
    pk-off  key-list encfile-rest ;

: save-all-msgs ( -- )
    saved-msg$ $@ bounds ?DO  I @ save-msgs  cell +LOOP
    saved-msg$ $free ;

: save-msgs? ( -- )
................................................................................
	\ try read backup instead
	[: enc-filename $. '~' emit ;] $tmp ['] decrypt@ catch
	?dup-IF  DoError 2drop
	ELSE  msg-eval  THEN
    ELSE  msg-eval  THEN
    replay-mode off  skip-sig? off  enc-file $free ;

event: :>save-msgs ( group-o -- ) saved-msg$ +unique$ ;
event: :>save-all-msgs ( -- )
    save-all-msgs ;
event: :>load-msg ( group-o -- )
    .msg:name$ load-msg ;

: >load-group ( group u -- )
    >group msg-group-o .msg:log[] $@len 0=
    IF  <event msg-group-o elit, :>load-msg
	parent .wait-task @
	dup 0= IF  drop ?file-task  THEN  event>  THEN ;

: !save-all-msgs ( -- )
    syncfile( save-all-msgs )else(
    <event :>save-all-msgs ?file-task event| ) ;

: save-msgs& ( -- )
    syncfile( last# saved-msg$ +unique$ )else(
    <event msg-group-o elit, :>save-msgs ?file-task event> ) ;



0 Value log#
2Variable last-msg

: +msg-log ( addr u -- addr' u' / 0 0 )

    [: msg-group-o .msg:log[] $ins[]date  dup  dup 0< xor to log#
	log# msg-group-o .msg:log[] $[]@ last-msg 2!
	0< IF  #0.  ELSE  last-msg 2@  THEN
    ;] msglog-sema c-section ;
: ?save-msg ( addr u -- )
    >group
    otr-mode @ replay-mode @ or 0= IF  save-msgs&  THEN ;


Sema queue-sema

\ peer queue, in msg context

: peer> ( -- addr / 0 )
    [: msg:peers[] back> ;] queue-sema c-section ;
................................................................................
    last# >r +msg-log last# ?dup-IF  $@ ?save-msg  THEN  r> to last# ;

: do-msg-nestsig ( addr u -- )
    2dup msg-group-o .msg:display
    msg-notify-o .msg:display ;

: display-lastn ( n -- )
    msg-group-o .msg:redisplay ;
: display-sync-done ( -- )
    rows  msg-group-o .msg:redisplay ;

: display-one-msg { d: msgt -- }
    msg-group-o >o
    msgt ['] msg:display catch IF  ." invalid entry"  cr  2drop  THEN
    o> ;
................................................................................
    parent dup IF  .wait-task @ dup up@ <> and  THEN
    ?dup-IF
	>r r@ <hide> <event $make elit, o elit, last# elit, :>msg-nestsig
	r> event>
    ELSE  do-msg-nestsig  THEN ;

: date>i ( date -- i )
    msg-group-o .msg:log[] $search[]date msg-group-o .msg:log[] $[]# 1- umin ;
: date>i' ( date -- i )
    msg-group-o .msg:log[] $search[]date msg-group-o .msg:log[] $[]# umin ;
: sighash? ( addr u -- flag )
    over le-64@ date>i
    dup 0< IF  drop 2drop  false  EXIT  THEN  >r
    over le-64@ 64#1 64+ date>i' >r [ 1 64s ]L /string
    r> r> U+DO
	c:0key I msg-group-o .msg:log[] $[]@ sigonly@ >hash
	2dup hashtmp over str= IF  2drop true  UNLOOP   EXIT
	ELSE  ( 2dup 85type ."  <> " hashtmp over 85type )  THEN
    LOOP
    2drop false ;

: msg-key! ( addr u -- )
    0 msg-keys[] [: rot >r 2over str= r> or ;] $[]map
................................................................................
:noname ( addr u -- ) $utf8>
    <warn> '#' forth:emit .group <default> ; msg-class is msg:tag
:noname ( addr u -- ) last# >r
    key| 2dup 0 .pk@ key| str=
    IF   <err>  THEN ." @" .key-id? <default>
    r> to last# ; msg-class is msg:signal
:noname ( addr u -- )
    last# >r last# $@ >group
    2dup sighash? IF  <info>  ELSE  <err>  THEN
    ."  <" over le-64@ .ticks
    verbose( dup keysize - /string ." ," 85type )else( 2drop ) <default>
    r> to last# ; msg-class is msg:chain
:noname ( addr u -- )
    space <warn> ." [" 85type ." ]->" <default> ; msg-class is msg:re
:noname ( addr u -- )
................................................................................
    2dup pk-sig? !!sig!! 2drop addrmsg umsg smove ;
: new-otrsig ( addr u -- addrsig usig )
    2dup startdate@ old>otr
    c:0key sigpksize# - c:hash ['] .sig $tmp 1 64s /string ;

:noname { sig u' addr u -- }
    u' 64'+ u =  u sigsize# = and IF
	last# >r last# $@ >group
	addr u startdate@ 64dup date>i >r 64#1 64+ date>i' r>
	2dup = IF  ."  [otrified] "  addr u startdate@ .ticks  THEN
	U+DO
	    I msg-group-o .msg:log[] $[]@
	    2dup dup sigpksize# - /string key| msg:id$ str= IF
		dup u - /string addr u str= IF
		    ."  OTRify #" I u.
		    sig u' I msg-group-o .msg:log[] $[]@ replace-sig
		    save-msgs&
		ELSE
		    ."  [OTRified] #" I u.
		THEN
	    ELSE
		2drop
	    THEN
................................................................................
: expect-msg ( o:connection -- )
    reply( ['] msg-reply )else( ['] drop ) expect-reply-xt +chat-control ;

User hashtmp$  hashtmp$ off

: last-msg@ ( -- ticks )
    last# >r
    last# $@ >group msg-group-o .msg:log[] $[]# ?dup-IF
	1- msg-group-o .msg:log[] $[]@ startdate@
    ELSE  64#0  THEN   r> to last# ;
: l.hashs ( end start -- hashaddr u )
    hashtmp$ $off
    msg-group-o .msg:log[] $[]# IF
	[: U+DO  I msg-group-o .msg:log[] $[]@ 1- dup 1 64s - safe/string forth:type
	  LOOP ;] hashtmp$ $exec hashtmp$ $@
	\ [: 2dup dump ;] stderr outfile-execute \ dump hash inputs
    ELSE  2drop s" "  THEN \ we have nothing yet
    >file-hash 1 64s umin ;
: i.date ( i -- )
    msg-group-o .msg:log[] $[]@ startdate@ 64#0 { 64^ x }
    x le-64! x 1 64s forth:type ;
: i.date+1 ( i -- )
    msg-group-o .msg:log[] $[]@ startdate@ 64#0 { 64^ x }
    64#1 64+ x le-64! x 1 64s forth:type ;
: last-msgs@ ( startdate enddate n -- addr u n' )
    \G print n intervals for messages from startdate to enddate
    \G The intervals contain the same size of messages except the
    \G last one, which may contain less (rounding down).
    \G Each interval contains a 64 bit hash of the last 64 bit of
    \G each message within the interval
    last# >r >r last# $@ >group purge-log
    msg-group-o .msg:log[] $[]#
    IF
	date>i' >r date>i' r> swap
	2dup - r> over >r 1- 1 max / 0 max 1+ -rot
	[: over >r U+DO  I i.date
	      dup I + I' umin I l.hashs forth:type
	  dup +LOOP
	  r> dup msg-group-o .msg:log[] $[]# u< IF  i.date
	  ELSE  1- i.date+1  THEN
	  drop ;] $tmp r> \ over 1 64s u> -
    ELSE  rdrop 64drop 64drop s" "  0 THEN   r> to last# ;

\ sync chatlog through virtual file access

termserver-class class
................................................................................

: msg:last? ( start end n -- )
    last# $@ $, msg-group
    max-last# umin
    last-msgs@ >r $, r> ulit, msg-last ;
: ?ask-msg-files ( addr u -- )
    64#-1 64#0 { 64^ startd 64^ endd } \ byte order of 0 and -1 don't matter
    last# $@ >group
    $> bounds ?DO
	I' I 64'+ u> IF
	    I le-64@ date>i'
	    I 64'+ 64'+ le-64@ date>i' swap
	    l.hashs drop le-64@
	    I 64'+ le-64@ 64<> IF
		I 64@ startd le-64@ 64umin
................................................................................
	parent .sync-none-xt \ sync-nothing-xt???
    THEN
    r> to last# ;

:noname ( -- 64len )
    \ poll serializes the 
    fs-outbuf $off
    fs-path $@ 2 64s /string >group
    msg-log@ over >r
    fs-path $@ drop le-64@ date>i \ start index
    fs-path $@ drop 64'+ le-64@ 64#1 64+ date>i' \ end index
    over - >r
    cells safe/string r> cells umin
    req? @ >r req? off  serialize-log   r> req? !  fs-outbuf $!buf
    r> free throw
    fs-outbuf $@len u>64 ; msgfs-class is fs-poll
................................................................................
    fs-close drop fs-path $!  fs-poll fs-size!
    ['] noop is file-xt
; msgfs-class is fs-open

\ syncing done
: chat-sync-done ( group-addr u -- )
    msg( ." chat-sync-done " 2dup forth:type forth:cr )
    >group display-sync-done !save-all-msgs
    net2o-code expect-msg close-all net2o:gen-reset end-code
    net2o:close-all
    ." === sync done ===" forth:cr sync-done-xt ;
event: :>msg-eval ( parent $pack $addr -- )
    { w^ buf w^ group }
    group $@ 2 64s /string { d: gname }
    gname >group
    msg-group-o .msg:log[] $[]# u.
    buf $@ true replay-mode ['] msg-eval !wrapper
    buf $free gname ?save-msg
    group $@ .chat-file ."  saved "
    msg-group-o .msg:log[] $[]# u. forth:cr
    >o -1 file-count +!@ 1 =
    IF  gname chat-sync-done  THEN  group $free
    o> ;
: msg-file-done ( -- )
    fs-path $@len IF
	msg( ." msg file done: " fs-path $@ .chat-file forth:cr )
	['] fs-flush file-sema c-section
................................................................................

previous

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

: last-signdate@ ( -- 64date )
    msg-group-o .msg:log[] $@ dup IF
	+ cell- $@ startdate@ 64#1 64+
    ELSE  2drop 64#-1  THEN ;

also net2o-base
: [msg,] ( xt -- )  last# >r
    msg-group$ $@ dup IF  message ?destpk 2dup >group $,
	execute  end-with
................................................................................
    last-signdate@ 64#1 64+ lit, 64#-1 lit, ask-last# ulit, msg-last? ;

: join, ( -- )
    [: msg-join sync-ahead?,
      sign[ msg-start "joined" $, msg-action msg-otr> ;] [msg,] ;

: silent-join, ( -- )
    msg-group$ $@ dup IF  message $, msg-join  end-with
    ELSE  2drop  THEN ;

: leave, ( -- )
    [: msg-leave
      sign[ msg-start "left" $, msg-action msg-otr> ;] [msg,] ;

: silent-leave, ( -- )
................................................................................
: msg-tdisplay ( addr u -- )
    sigpksize# - 2dup + sigpksize# >$  c-state off
    nest-cmd-loop msg:end ;
' msg-tdisplay msg-class is msg:display
' msg-tdisplay msg-notify-class is msg:display
: msg-tredisplay ( n -- )
    reset-time  0 otr-mode
    [:  cells >r msg-log@ 2dup { log u }
	dup r> - 0 max /string bounds ?DO
	    I log - cell/ to log#
	    I $@ { d: msgt }
	    msgt ['] msg:display catch IF  ." invalid entry" cr
		2drop  THEN
	cell +LOOP
	log free throw ;] !wrapper ;
................................................................................

64Variable line-date 64#-1 line-date 64!
Variable $lastline

: !date ( addr u -- addr u )
    2dup + sigsize# - le-64@ line-date 64! ;
: find-prev-chatline { maxlen addr -- max span addr span }
    msg-group$ $@ >group
    msg-group-o .msg:log[] $[]# 0= IF  maxlen 0 addr over  EXIT  THEN
    line-date 64@ date>i'
    BEGIN  1- dup 0>= WHILE  dup msg-group-o .msg:log[] $[]@
	dup sigpksize# - /string key| pk@ key| str=  UNTIL  THEN
    msg-group-o .msg:log[] $[]@ dup 0= IF  nip
    ELSE  !date ['] msg:display textmsg-o .$tmp 
	dup maxlen u> IF  dup >r maxlen 0 addr over r> grow-tib
	    2drop to addr drop to maxlen  THEN
	tuck addr maxlen smove
    THEN
    maxlen swap addr over ;
: find-next-chatline { maxlen addr -- max span addr span }
    msg-group$ $@ >group
    line-date 64@ date>i
    BEGIN  1+ dup msg-group-o .msg:log[] $[]# u< WHILE  dup msg-group-o .msg:log[] $[]@
	dup sigpksize# - /string key| pk@ key| str=  UNTIL  THEN
    dup msg-group-o .msg:log[] $[]# u>=
    IF    drop $lastline $@  64#-1 line-date 64!
    ELSE  msg-group-o .msg:log[] $[]@ !date ['] msg:display textmsg-o .$tmp  THEN
    dup maxlen u> IF  dup >r maxlen 0 addr over r> grow-tib
	2drop to addr drop to maxlen  THEN
    tuck addr maxlen smove
    maxlen swap addr over ;

: chat-prev-line  ( max span addr pos1 -- max span addr pos2 false )
    line-date 64@ 64#-1 64= IF
................................................................................
also net2o-base
\ chain messages to one previous message
: chain, ( msgaddr u -- )
    [: 2dup startdate@ 64#0 { 64^ sd } sd le-64!  sd 1 64s forth:type
	c:0key sigonly@ >hash hashtmp hash#128 forth:type ;] $tmp $, msg-chain ;

: ?chain, ( -- )  chain-mode @ 0= ?EXIT

    msg-group-o .msg:log[] $[]# 1- dup 0< IF  drop

    ELSE  msg-group-o .msg:log[] $[]@ chain,
    THEN ;

: (send-avalanche) ( xt -- addr u flag )
    [: 0 >o [: sign[ msg-start execute ?chain, msg> ;] gen-cmd$ o>
      +last-signed msg-log, ;] [group] ;
previous
: send-avalanche ( xt -- )
    otr-mode @ IF  now>otr  ELSE  now>never  THEN
................................................................................
    ['] nick>chat arg-loop ;

\ do otrify

also net2o-base

: do-otrify ( n -- ) >r
    msg-group$ $@ >group msg-group-o .msg:log[] $@ r> cells safe/string
    IF  $@ 2dup + sigpksize# - sigpksize#
	over keysize pkc over str= IF
	    keysize /string 2swap new-otrsig 2swap
	    $, $, msg-otrify
	ELSE
	    2drop 2drop ." not your message!" forth:cr
	THEN
................................................................................

: /chats ( addr u -- ) 2drop ." ===== chats: "
    \U chats                list chats
    \G chats: list all chats
    [:  msg:name$ msg-group$ $@ str= IF ." *" THEN
	msg:name$ .group
	." [" msg:peers[] $[]# 0 .r ." ]#"
	msg:log[] $[]# u. ;] group#map
    ." =====" forth:cr ;

: /nat ( addr u -- )  2drop
    \U nat                  list NAT info
    \G nat: list nat traversal information of all peers in all groups
    \U renat                redo NAT traversal
    \G renat: redo nat traversal
................................................................................
    \U n2o <cmd>            execute n2o command
    \G n2o: Execute normal n2o command

: /sync ( addr u -- )
    \U sync [+date] [-date] synchronize logs
    \G sync: synchronize chat logs, starting and/or ending at specific
    \G sync: time/date
    s>unumber? IF  drop  ELSE  2drop 0  THEN  cells >r
    msg-group-o .msg:peers[] $@ r@ u<= IF  drop rdrop  EXIT  THEN
    r> + @ >o o to connection
    ." === sync ===" forth:cr
    net2o-code expect-msg [: msg-group last?, ;] [msg,] end-code o> ;

: /version ( addr u -- )
    \U version              version string
    \G version: print version string
    2drop .n2o-version space .gforth-version forth:cr ;

: /log ( addr u -- )
    \U log [#lines]         show log
    \G log: show the log, default is a screenful
    s>unumber? IF  drop >r  ELSE  2drop rows >r  THEN
    msg-group$ $@ >group purge-log
    r>  display-lastn ;

: /logstyle ( addr u -- )
    \U logstyle [+-style]   set log style
    \G logstyle: set log styles, the following settings exist:
    \G logstyle: +date      a date per log line
    \G logstyle: +num       a message number per log line
................................................................................

: avalanche-text ( addr u -- ) >utf8$
    [: parse-text ;] send-avalanche ;

previous

: load-msgn ( addr u n -- )
    >r load-msg r> display-lastn ;

: +group ( -- ) msg-group$ $@ >group +unique-con ;

: msg-timeout ( -- )
    packets2 @  connected-timeout  packets2 @ <>
    IF  reply( ." Resend to " pubkey $@ key>nick type cr )
	timeout-expired? IF
................................................................................
      ELSE  nip nip  THEN ;] $[]map ;

: key>group ( addr u -- pk u )
    @/ 2swap tuck msg-group$ $!  0=
    IF  2dup key| msg-group$ $!  THEN ; \ 1:1 chat-group=key

: ?load-msgn ( -- )
    msg-group$ $@ >group msg-group-o .msg:log[] $@len 0= IF
	msg-group$ $@ rows load-msgn  THEN ;

: chat-connects ( -- )
    chat-keys [: key>group ?load-msgn
      dup 0= IF  2drop msg-group$ $@ >group  EXIT  THEN
      2dup search-connect ?dup-IF  >o +group greet o> 2drop EXIT  THEN
      2dup pk-peek?  IF  chat-connect  ELSE  2drop  THEN ;] $[]map ;
................................................................................
    REPEAT  2drop leave-chats  xchar-history
    nr> set-order ;

: avalanche-to ( addr u o:context -- )
    avalanche( ." Send avalanche to: " pubkey $@ key>nick type space over hex. cr )
    o to connection
    net2o-code expect-msg message
    msg-group-o .msg:name$ 2dup pubkey $@ key| str= IF  2drop  ELSE  group,  THEN
    $, nestsig end-with
    end-code ;

\\\
Local Variables:
forth-local-words:
    (

Changes to vault.fs.

102
103
104
105
106
107
108
109
110
111
112
113
114
115
116

$80 Constant min-align#
$400 Constant pow-align#

: vault-aligned ( len -- len' )
    \G Align vault to minimum granularity plus relative alignment
    \G to hide the actual file-size
    1- 0 >r  BEGIN  dup pow-align# u>  WHILE  2/ r> 1+ >r  REPEAT
    1+ r> lshift  min-align# 1- + min-align# negate and ;

Variable enc-mode

: enc-keccak ( -- )        $60 enc-mode ! ; \ wrap with keccak
: enc-threefish ( -- ) $010160 enc-mode ! ; \ wrap with threefish
: enc>crypt2 ( -- )







|







102
103
104
105
106
107
108
109
110
111
112
113
114
115
116

$80 Constant min-align#
$400 Constant pow-align#

: vault-aligned ( len -- len' )
    \G Align vault to minimum granularity plus relative alignment
    \G to hide the actual file-size
    1- 0 >r  BEGIN  dup pow-align# u>  WHILE  1 rshift r> 1+ >r  REPEAT
    1+ r> lshift  min-align# 1- + min-align# negate and ;

Variable enc-mode

: enc-keccak ( -- )        $60 enc-mode ! ; \ wrap with keccak
: enc-threefish ( -- ) $010160 enc-mode ! ; \ wrap with threefish
: enc>crypt2 ( -- )