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

    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

' 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

' 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

    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:
    (

    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:
    (

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

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