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: | 2326543d3ad938bb63bc099a3f314e4b | 
| User & Date: | bernd 2019-06-20 22:13:20.990 | 
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
Changes to cmd.fs.
| ︙ | ︙ | |||
| 705 706 707 708 709 710 711 | 
    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$
 | | < | | | | 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 | 
' 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 -- )
 | | | | 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 | 
' 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# #!
 | 
| ︙ | ︙ | |||
| 671 672 673 674 675 676 677 | 
: dispose-dvcs-log ( o:log -- )
    clear-log dispose ;
}scope
: display-logn ( addr u n -- )
    project:branch$ $@ { d: branch }
    dvcs:new-dvcs-log >o
 | | | 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 | 
: 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
 | 
| ︙ | ︙ | |||
| 858 859 860 861 862 863 864 | 
: 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 -- )
 | | | | 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 | 
: 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
 | 
| ︙ | ︙ | |||
| 981 982 983 984 985 986 987 | 
	    THEN
\	    ELSE  end-code  THEN
	/sync-files +LOOP
    /sync-reqs +LOOP ;
: dvcs-data-sync ( -- )
    sync-file-list[] $[]off  branches[] $[]off
 | | | 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 | 
	    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 | 
    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 ;
 | < < | | | < < < | | | | | | | 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 55 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 88 89 90 91 92 93 94 95 96 97 | 
    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?
Sema msglog-sema
: ?msg-context ( -- o )
    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
	REPEAT  drop ;] msglog-sema c-section ;
: serialize-log ( addr u -- $addr )
    [: bounds ?DO
	    I $@ check-date 0= IF  net2o-base:$, net2o-base:nestsig
	    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? ( -- )
 | 
| ︙ | ︙ | |||
| 119 120 121 122 123 124 125 | 
	\ 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 ;
 | | | | | | | < < < | | | | < | 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 | 
	\ 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 ;
 | 
| ︙ | ︙ | |||
| 178 179 180 181 182 183 184 | 
    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 -- )
 | | | 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 | 
    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> ;
 | 
| ︙ | ︙ | |||
| 317 318 319 320 321 322 323 | 
    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 )
 | | | | | 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 | 
    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
 | 
| ︙ | ︙ | |||
| 446 447 448 449 450 451 452 | 
: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 -- )
 | | | 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 | 
: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 -- )
 | 
| ︙ | ︙ | |||
| 497 498 499 500 501 502 503 | 
    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
 | | | | | 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 | 
    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
 | 
| ︙ | ︙ | |||
| 752 753 754 755 756 757 758 | 
: expect-msg ( o:connection -- )
    reply( ['] msg-reply )else( ['] drop ) expect-reply-xt +chat-control ;
User hashtmp$  hashtmp$ off
: last-msg@ ( -- ticks )
    last# >r
 | | | | | | | | | | | 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 | 
: 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
 | 
| ︙ | ︙ | |||
| 819 820 821 822 823 824 825 | 
: 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
 | | | 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 | 
: 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
 | 
| ︙ | ︙ | |||
| 857 858 859 860 861 862 863 | 
	parent .sync-none-xt \ sync-nothing-xt???
    THEN
    r> to last# ;
:noname ( -- 64len )
    \ poll serializes the 
    fs-outbuf $off
 | | | | | | | | 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 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 | 
	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
:noname ( addr u mode -- )
    \G addr u is starttick endtick name concatenated together
    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
 | 
| ︙ | ︙ | |||
| 943 944 945 946 947 948 949 | 
previous
: ?destpk ( addr u -- addr' u' )
    2dup connection .pubkey $@ key| str= IF  2drop pk@ key|  THEN ;
: last-signdate@ ( -- 64date )
 | | | 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 | 
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
 | 
| ︙ | ︙ | |||
| 971 972 973 974 975 976 977 | 
    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, ( -- )
 | | | 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 | 
    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, ( -- )
 | 
| ︙ | ︙ | |||
| 1018 1019 1020 1021 1022 1023 1024 | 
: 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
 | | | 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 | 
: 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 ;
 | 
| ︙ | ︙ | |||
| 1054 1055 1056 1057 1058 1059 1060 | 
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 }
 | | | | | | | | | | 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 | 
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
 | 
| ︙ | ︙ | |||
| 1174 1175 1176 1177 1178 1179 1180 | 
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
 | < | | | | 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 | 
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
 | 
| ︙ | ︙ | |||
| 1216 1217 1218 1219 1220 1221 1222 | 
    ['] nick>chat arg-loop ;
\ do otrify
also net2o-base
: do-otrify ( n -- ) >r
 | | | 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 | 
    ['] 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
 | 
| ︙ | ︙ | |||
| 1379 1380 1381 1382 1383 1384 1385 | 
: /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 ." ]#"
 | | | 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 | 
: /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
 | 
| ︙ | ︙ | |||
| 1428 1429 1430 1431 1432 1433 1434 | 
    \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
 | > | | | | 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 | 
    \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
 | 
| ︙ | ︙ | |||
| 1546 1547 1548 1549 1550 1551 1552 | 
: avalanche-text ( addr u -- ) >utf8$
    [: parse-text ;] send-avalanche ;
previous
: load-msgn ( addr u n -- )
 | | | 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 | 
: 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
 | 
| ︙ | ︙ | |||
| 1615 1616 1617 1618 1619 1620 1621 | 
      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 ( -- )
 | | | 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 | 
      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 ;
 | 
| ︙ | ︙ | |||
| 1736 1737 1738 1739 1740 1741 1742 | 
    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
 | | | 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 | 
    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 | 
$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
 | | | 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 ( -- )
 | 
| ︙ | ︙ |