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 Side-by-Side Diffs Ignore Whitespace Patch

Changes to cmd.fs.

   705    705       IF  own-crypt-val do-nest  ELSE
   706    706   	<err> ." cmdnest: no owncrypt, un-cmd" <default> forth:cr
   707    707   	un-cmd  THEN ;
   708    708   
   709    709   : cmdtmpnest ( addr u -- )
   710    710       $>align tmpkey@ key| dup IF
   711    711   	key( ." tmpnest key: " 2dup 85type forth:cr ) decrypt$
   712         -	IF    tmp-crypt-val do-nest
   713         -	ELSE
   714         -	    <err> ." tmpnest failed, uncmd" <default> forth:cr
   715         -	    net2o:see-me 2drop un-cmd  THEN
   716         -    ELSE  2drop 2drop un-cmd  THEN ;
          712  +	IF    tmp-crypt-val do-nest  EXIT  THEN
          713  +	cmd( <err> ." tmpnest failed, uncmd" <default> forth:cr
          714  +	net2o:see-me )
          715  +    ELSE  2drop  THEN  2drop un-cmd ;
   717    716   : cmdencnest ( addr u -- )
   718    717       $>align tmpkey@ dup IF
   719    718   	key( ." encnest key: " 2dup 85type forth:cr ) decrypt$
   720    719   	IF    enc-crypt-val do-nest  [ qr-tmp-val invert ]L validated and!
   721    720   	ELSE <err> ." encnest failed, uncmd" <default> forth:cr
   722    721   	    2drop un-cmd  THEN
   723    722       ELSE  <err> ." encnest: no tmpkey" <default> forth:cr

Changes to dvcs.fs.

   609    609   ' drop dvcs-log-class is msg:redisplay
   610    610   
   611    611   : chat>dvcs ( o:dvcs -- )
   612    612       project:project$ $@ @/ 2drop load-msg ;
   613    613   : .hash ( addr -- )
   614    614       [: dup $@ 85type ."  -> " cell+ $@ 85type cr ;] #map ;
   615    615   : chat>branches-loop ( o:commit -- )
   616         -    last# msg-log@ over { log } bounds ?DO
          616  +    msg-log@ over { log } bounds ?DO
   617    617   	re$ $free  object$ $free
   618    618   	I $@ ['] msg:display catch IF  ." invalid entry" cr 2drop THEN
   619    619       cell +LOOP  log free throw
   620    620       dvcs( ." === id>patch ===" cr id>patch# .hash
   621    621       ." === id>snap ===" cr id>snap# .hash ) ;
   622    622   : chat>branches ( o:dvcs -- )
   623         -    project:project$ $@ @/ 2drop ?msg-log  dvcs:commits @ .chat>branches-loop ;
          623  +    project:project$ $@ @/ 2drop >group  dvcs:commits @ .chat>branches-loop ;
   624    624   
   625    625   : >branches ( addr u -- )
   626    626       $make branches[] >back ;
   627    627   User id-check# \ check hash
   628    628   : id>branches-loop ( addr u -- )
   629    629       BEGIN  2dup id-check# #@ d0<> IF  2drop  EXIT  THEN
   630    630   	s" !" 2over id-check# #!
................................................................................
   671    671   : dispose-dvcs-log ( o:log -- )
   672    672       clear-log dispose ;
   673    673   }scope
   674    674   
   675    675   : display-logn ( addr u n -- )
   676    676       project:branch$ $@ { d: branch }
   677    677       dvcs:new-dvcs-log >o
   678         -    cells >r ?msg-log  last# msg-log@ 2dup { log u }
          678  +    cells >r >group  msg-log@ 2dup { log u }
   679    679       dup r> - 0 max dup >r /string r> cell/ -rot bounds ?DO
   680    680   	dvcs:clear-log  I $@ ['] msg:display catch
   681    681   	IF  ." invalid entry" cr 2drop
   682    682   	ELSE
   683    683   	    branch dvcs-log:tag$ $@ str= IF
   684    684   		dup 0 .r ." : [" dvcs-log:id$ $@ 85type ." ] "
   685    685   		dvcs-log:sig$ $@ 2dup startdate@ .ticks
................................................................................
   858    858   
   859    859   : dvcs-co ( addr u -- ) \ checkout revision
   860    860       base85>$  dvcs:new-dvcs >o
   861    861       config>dvcs   dvcs:id$ $! dvcs:id$  dvcs-readin  co-rest
   862    862       dvcs:dispose-dvcs o> ;
   863    863   
   864    864   : chat>searchs-loop ( o:commit -- )
   865         -    last# msg-log@ over { log } bounds ?DO
          865  +    msg-log@ over { log } bounds ?DO
   866    866   	I $@ ['] msg:display catch IF  ." invalid entry" cr 2drop THEN
   867    867       cell +LOOP  log free throw ;
   868    868   : search-last-rev ( -- addr u )
   869         -    project:project$ $@ @/ 2drop ?msg-log
          869  +    project:project$ $@ @/ 2drop >group
   870    870       project:branch$ $@
   871    871       dvcs:searchs @ >o match:tag$ $!
   872    872       chat>searchs-loop match:id$ $@ o> ;
   873    873   
   874    874   : dvcs-up ( -- ) \ checkout latest revision
   875    875       dvcs:new-dvcs >o
   876    876       pull-readin  files>dvcs  new>dvcs  dvcs?modified
................................................................................
   981    981   	    THEN
   982    982   \	    ELSE  end-code  THEN
   983    983   	/sync-files +LOOP
   984    984       /sync-reqs +LOOP ;
   985    985   
   986    986   : dvcs-data-sync ( -- )
   987    987       sync-file-list[] $[]off  branches[] $[]off
   988         -    msg-group$ $@ ?msg-log
          988  +    msg-group$ $@ >group
   989    989       dvcs:commits @ .chat>branches-loop
   990    990       dvcs:commits @ .dvcs-needed-files
   991    991       sync-file-list[] $[]# 0> connection and
   992    992       IF    sync-file-list[] connection .get-needed-files  THEN ;
   993    993   
   994    994   : dvcs-ref-sync ( -- )
   995    995       search-last-rev id>branches

Changes to msg.fs.

    28     28       2dup msg-group# #@ d0= IF
    29     29   	net2o:new-msg >o 2dup to msg:name$ o o>
    30     30   	cell- [ msg-class >osize @ cell+ ]L
    31     31   	2over msg-group# #!
    32     32       THEN  last# cell+ $@ drop cell+ to msg-group-o
    33     33       2drop ;
    34     34   
    35         -also msg
    36         -
    37     35   : avalanche-msg ( msg u1 o:connect -- )
    38     36       \G forward message to all next nodes of that message group
    39         -    { d: msg }
    40         -    msg-group-o .peers[] $@
    41         -    bounds ?DO  I @ o <> IF  msg I @ .avalanche-to  THEN
           37  +    { d: msgx }
           38  +    msg-group-o .msg:peers[] $@
           39  +    bounds ?DO  I @ o <> IF  msgx I @ .avalanche-to  THEN
    42     40       cell +LOOP ;
    43     41   
    44         -previous
    45         -
    46     42   Variable msg-group$
    47         -Variable msg-logs
    48     43   Variable otr-mode
    49     44   Variable chain-mode
    50     45   Variable redate-mode
    51     46   Variable lock-mode
    52     47   Variable msg-keys[]
    53     48   User replay-mode
    54     49   User skip-sig?
................................................................................
    59     54       msging-context @ dup 0= IF
    60     55   	drop
    61     56   	net2o:new-msging dup msging-context !
    62     57       THEN ;
    63     58   
    64     59   : >chatid ( group u -- id u )  defaultkey sec@ keyed-hash#128 ;
    65     60   
    66         -: msg-log@ ( last# -- addr u )
    67         -    [: cell+ $@ save-mem ;] msglog-sema c-section ;
           61  +: msg-log@ ( -- addr u )
           62  +    [: msg-group-o .msg:log[] $@ save-mem ;] msglog-sema c-section ;
    68     63   
    69     64   : purge-log ( -- )
    70         -    [: last# cell+ { a[] }
           65  +    [: msg-group-o .msg:log[] { a[] }
    71     66   	0  BEGIN  dup a[] $[]# u<  WHILE
    72     67   		dup a[] $[]@ check-date nip nip IF
    73     68   		    dup a[] $[] $free
    74     69   		    a[] over cells cell $del
    75     70   		ELSE
    76     71   		    1+
    77     72   		THEN
................................................................................
    83     78   	    ELSE   2drop  THEN
    84     79         cell +LOOP ;]
    85     80       gen-cmd ;
    86     81   
    87     82   Variable saved-msg$
    88     83   64Variable saved-msg-ticks
    89     84   
    90         -: save-msgs ( last -- )
           85  +: save-msgs ( group-o -- ) to msg-group-o
    91     86       msg( ." Save messages" cr )
    92     87       ?.net2o/chats  net2o:new-msging >o
    93         -    dup msg-log@ over >r  serialize-log enc-file $!buf
           88  +    msg-log@ over >r  serialize-log enc-file $!buf
    94     89       r> free throw  dispose o>
    95         -    $@ >chatid .chats/ enc-filename $!
           90  +    msg-group-o .msg:name$ >chatid .chats/ enc-filename $!
    96     91       pk-off  key-list encfile-rest ;
    97     92   
    98     93   : save-all-msgs ( -- )
    99     94       saved-msg$ $@ bounds ?DO  I @ save-msgs  cell +LOOP
   100     95       saved-msg$ $free ;
   101     96   
   102     97   : save-msgs? ( -- )
................................................................................
   119    114   	\ try read backup instead
   120    115   	[: enc-filename $. '~' emit ;] $tmp ['] decrypt@ catch
   121    116   	?dup-IF  DoError 2drop
   122    117   	ELSE  msg-eval  THEN
   123    118       ELSE  msg-eval  THEN
   124    119       replay-mode off  skip-sig? off  enc-file $free ;
   125    120   
   126         -event: :>save-msgs ( last# -- ) saved-msg$ +unique$ ;
          121  +event: :>save-msgs ( group-o -- ) saved-msg$ +unique$ ;
   127    122   event: :>save-all-msgs ( -- )
   128    123       save-all-msgs ;
   129         -event: :>load-msg ( last# -- )
   130         -    $@ load-msg ;
          124  +event: :>load-msg ( group-o -- )
          125  +    .msg:name$ load-msg ;
   131    126   
   132    127   : >load-group ( group u -- )
   133         -    2dup msg-logs #@ d0= >r >group r>
   134         -    IF  <event last# elit, :>load-msg
          128  +    >group msg-group-o .msg:log[] $@len 0=
          129  +    IF  <event msg-group-o elit, :>load-msg
   135    130   	parent .wait-task @
   136    131   	dup 0= IF  drop ?file-task  THEN  event>  THEN ;
   137    132   
   138    133   : !save-all-msgs ( -- )
   139    134       syncfile( save-all-msgs )else(
   140    135       <event :>save-all-msgs ?file-task event| ) ;
   141    136   
   142    137   : save-msgs& ( -- )
   143    138       syncfile( last# saved-msg$ +unique$ )else(
   144         -    <event last# elit, :>save-msgs ?file-task event> ) ;
   145         -
   146         -: ?msg-log ( addr u -- )  msg-logs ?hash ;
          139  +    <event msg-group-o elit, :>save-msgs ?file-task event> ) ;
   147    140   
   148    141   0 Value log#
   149    142   2Variable last-msg
   150    143   
   151    144   : +msg-log ( addr u -- addr' u' / 0 0 )
   152         -    last# $@ ?msg-log
   153         -    [: last# cell+ $ins[]date  dup  dup 0< xor to log#
   154         -	log# last# cell+ $[]@ last-msg 2!
          145  +    [: msg-group-o .msg:log[] $ins[]date  dup  dup 0< xor to log#
          146  +	log# msg-group-o .msg:log[] $[]@ last-msg 2!
   155    147   	0< IF  #0.  ELSE  last-msg 2@  THEN
   156    148       ;] msglog-sema c-section ;
   157    149   : ?save-msg ( addr u -- )
   158         -    ?msg-log
   159         -    last# otr-mode @ replay-mode @ or 0= and
   160         -    IF  save-msgs&  THEN ;
          150  +    >group
          151  +    otr-mode @ replay-mode @ or 0= IF  save-msgs&  THEN ;
   161    152   
   162    153   Sema queue-sema
   163    154   
   164    155   \ peer queue, in msg context
   165    156   
   166    157   : peer> ( -- addr / 0 )
   167    158       [: msg:peers[] back> ;] queue-sema c-section ;
................................................................................
   178    169       last# >r +msg-log last# ?dup-IF  $@ ?save-msg  THEN  r> to last# ;
   179    170   
   180    171   : do-msg-nestsig ( addr u -- )
   181    172       2dup msg-group-o .msg:display
   182    173       msg-notify-o .msg:display ;
   183    174   
   184    175   : display-lastn ( n -- )
   185         -    msg-group-o >o msg:redisplay o> ;
          176  +    msg-group-o .msg:redisplay ;
   186    177   : display-sync-done ( -- )
   187    178       rows  msg-group-o .msg:redisplay ;
   188    179   
   189    180   : display-one-msg { d: msgt -- }
   190    181       msg-group-o >o
   191    182       msgt ['] msg:display catch IF  ." invalid entry"  cr  2drop  THEN
   192    183       o> ;
................................................................................
   317    308       parent dup IF  .wait-task @ dup up@ <> and  THEN
   318    309       ?dup-IF
   319    310   	>r r@ <hide> <event $make elit, o elit, last# elit, :>msg-nestsig
   320    311   	r> event>
   321    312       ELSE  do-msg-nestsig  THEN ;
   322    313   
   323    314   : date>i ( date -- i )
   324         -    last# cell+ $search[]date last# cell+ $[]# 1- umin ;
          315  +    msg-group-o .msg:log[] $search[]date msg-group-o .msg:log[] $[]# 1- umin ;
   325    316   : date>i' ( date -- i )
   326         -    last# cell+ $search[]date last# cell+ $[]# umin ;
          317  +    msg-group-o .msg:log[] $search[]date msg-group-o .msg:log[] $[]# umin ;
   327    318   : sighash? ( addr u -- flag )
   328    319       over le-64@ date>i
   329    320       dup 0< IF  drop 2drop  false  EXIT  THEN  >r
   330    321       over le-64@ 64#1 64+ date>i' >r [ 1 64s ]L /string
   331    322       r> r> U+DO
   332         -	c:0key I last# cell+ $[]@ sigonly@ >hash
          323  +	c:0key I msg-group-o .msg:log[] $[]@ sigonly@ >hash
   333    324   	2dup hashtmp over str= IF  2drop true  UNLOOP   EXIT
   334    325   	ELSE  ( 2dup 85type ."  <> " hashtmp over 85type )  THEN
   335    326       LOOP
   336    327       2drop false ;
   337    328   
   338    329   : msg-key! ( addr u -- )
   339    330       0 msg-keys[] [: rot >r 2over str= r> or ;] $[]map
................................................................................
   446    437   :noname ( addr u -- ) $utf8>
   447    438       <warn> '#' forth:emit .group <default> ; msg-class is msg:tag
   448    439   :noname ( addr u -- ) last# >r
   449    440       key| 2dup 0 .pk@ key| str=
   450    441       IF   <err>  THEN ." @" .key-id? <default>
   451    442       r> to last# ; msg-class is msg:signal
   452    443   :noname ( addr u -- )
   453         -    last# >r last# $@ ?msg-log
          444  +    last# >r last# $@ >group
   454    445       2dup sighash? IF  <info>  ELSE  <err>  THEN
   455    446       ."  <" over le-64@ .ticks
   456    447       verbose( dup keysize - /string ." ," 85type )else( 2drop ) <default>
   457    448       r> to last# ; msg-class is msg:chain
   458    449   :noname ( addr u -- )
   459    450       space <warn> ." [" 85type ." ]->" <default> ; msg-class is msg:re
   460    451   :noname ( addr u -- )
................................................................................
   497    488       2dup pk-sig? !!sig!! 2drop addrmsg umsg smove ;
   498    489   : new-otrsig ( addr u -- addrsig usig )
   499    490       2dup startdate@ old>otr
   500    491       c:0key sigpksize# - c:hash ['] .sig $tmp 1 64s /string ;
   501    492   
   502    493   :noname { sig u' addr u -- }
   503    494       u' 64'+ u =  u sigsize# = and IF
   504         -	last# >r last# $@ ?msg-log
          495  +	last# >r last# $@ >group
   505    496   	addr u startdate@ 64dup date>i >r 64#1 64+ date>i' r>
   506    497   	2dup = IF  ."  [otrified] "  addr u startdate@ .ticks  THEN
   507    498   	U+DO
   508         -	    I last# cell+ $[]@
          499  +	    I msg-group-o .msg:log[] $[]@
   509    500   	    2dup dup sigpksize# - /string key| msg:id$ str= IF
   510    501   		dup u - /string addr u str= IF
   511    502   		    ."  OTRify #" I u.
   512         -		    sig u' I last# cell+ $[]@ replace-sig
          503  +		    sig u' I msg-group-o .msg:log[] $[]@ replace-sig
   513    504   		    save-msgs&
   514    505   		ELSE
   515    506   		    ."  [OTRified] #" I u.
   516    507   		THEN
   517    508   	    ELSE
   518    509   		2drop
   519    510   	    THEN
................................................................................
   752    743   : expect-msg ( o:connection -- )
   753    744       reply( ['] msg-reply )else( ['] drop ) expect-reply-xt +chat-control ;
   754    745   
   755    746   User hashtmp$  hashtmp$ off
   756    747   
   757    748   : last-msg@ ( -- ticks )
   758    749       last# >r
   759         -    last# $@ ?msg-log last# cell+ $[]# ?dup-IF
   760         -	1- last# cell+ $[]@ startdate@
          750  +    last# $@ >group msg-group-o .msg:log[] $[]# ?dup-IF
          751  +	1- msg-group-o .msg:log[] $[]@ startdate@
   761    752       ELSE  64#0  THEN   r> to last# ;
   762    753   : l.hashs ( end start -- hashaddr u )
   763    754       hashtmp$ $off
   764         -    last# cell+ $[]# IF
   765         -	[: U+DO  I last# cell+ $[]@ 1- dup 1 64s - safe/string forth:type
          755  +    msg-group-o .msg:log[] $[]# IF
          756  +	[: U+DO  I msg-group-o .msg:log[] $[]@ 1- dup 1 64s - safe/string forth:type
   766    757   	  LOOP ;] hashtmp$ $exec hashtmp$ $@
   767    758   	\ [: 2dup dump ;] stderr outfile-execute \ dump hash inputs
   768    759       ELSE  2drop s" "  THEN \ we have nothing yet
   769    760       >file-hash 1 64s umin ;
   770    761   : i.date ( i -- )
   771         -    last# cell+ $[]@ startdate@ 64#0 { 64^ x }
          762  +    msg-group-o .msg:log[] $[]@ startdate@ 64#0 { 64^ x }
   772    763       x le-64! x 1 64s forth:type ;
   773    764   : i.date+1 ( i -- )
   774         -    last# cell+ $[]@ startdate@ 64#0 { 64^ x }
          765  +    msg-group-o .msg:log[] $[]@ startdate@ 64#0 { 64^ x }
   775    766       64#1 64+ x le-64! x 1 64s forth:type ;
   776    767   : last-msgs@ ( startdate enddate n -- addr u n' )
   777    768       \G print n intervals for messages from startdate to enddate
   778    769       \G The intervals contain the same size of messages except the
   779    770       \G last one, which may contain less (rounding down).
   780    771       \G Each interval contains a 64 bit hash of the last 64 bit of
   781    772       \G each message within the interval
   782         -    last# >r >r last# $@ ?msg-log purge-log
   783         -    last# cell+ $[]#
          773  +    last# >r >r last# $@ >group purge-log
          774  +    msg-group-o .msg:log[] $[]#
   784    775       IF
   785    776   	date>i' >r date>i' r> swap
   786    777   	2dup - r> over >r 1- 1 max / 0 max 1+ -rot
   787    778   	[: over >r U+DO  I i.date
   788    779   	      dup I + I' umin I l.hashs forth:type
   789    780   	  dup +LOOP
   790         -	  r> dup last# cell+ $[]# u< IF  i.date
          781  +	  r> dup msg-group-o .msg:log[] $[]# u< IF  i.date
   791    782   	  ELSE  1- i.date+1  THEN
   792    783   	  drop ;] $tmp r> \ over 1 64s u> -
   793    784       ELSE  rdrop 64drop 64drop s" "  0 THEN   r> to last# ;
   794    785   
   795    786   \ sync chatlog through virtual file access
   796    787   
   797    788   termserver-class class
................................................................................
   819    810   
   820    811   : msg:last? ( start end n -- )
   821    812       last# $@ $, msg-group
   822    813       max-last# umin
   823    814       last-msgs@ >r $, r> ulit, msg-last ;
   824    815   : ?ask-msg-files ( addr u -- )
   825    816       64#-1 64#0 { 64^ startd 64^ endd } \ byte order of 0 and -1 don't matter
   826         -    last# $@ ?msg-log
          817  +    last# $@ >group
   827    818       $> bounds ?DO
   828    819   	I' I 64'+ u> IF
   829    820   	    I le-64@ date>i'
   830    821   	    I 64'+ 64'+ le-64@ date>i' swap
   831    822   	    l.hashs drop le-64@
   832    823   	    I 64'+ le-64@ 64<> IF
   833    824   		I 64@ startd le-64@ 64umin
................................................................................
   857    848   	parent .sync-none-xt \ sync-nothing-xt???
   858    849       THEN
   859    850       r> to last# ;
   860    851   
   861    852   :noname ( -- 64len )
   862    853       \ poll serializes the 
   863    854       fs-outbuf $off
   864         -    fs-path $@ 2 64s /string ?msg-log
   865         -    last# msg-log@ over >r
          855  +    fs-path $@ 2 64s /string >group
          856  +    msg-log@ over >r
   866    857       fs-path $@ drop le-64@ date>i \ start index
   867    858       fs-path $@ drop 64'+ le-64@ 64#1 64+ date>i' \ end index
   868    859       over - >r
   869    860       cells safe/string r> cells umin
   870    861       req? @ >r req? off  serialize-log   r> req? !  fs-outbuf $!buf
   871    862       r> free throw
   872    863       fs-outbuf $@len u>64 ; msgfs-class is fs-poll
................................................................................
   875    866       fs-close drop fs-path $!  fs-poll fs-size!
   876    867       ['] noop is file-xt
   877    868   ; msgfs-class is fs-open
   878    869   
   879    870   \ syncing done
   880    871   : chat-sync-done ( group-addr u -- )
   881    872       msg( ." chat-sync-done " 2dup forth:type forth:cr )
   882         -    ?msg-log display-sync-done !save-all-msgs
          873  +    >group display-sync-done !save-all-msgs
   883    874       net2o-code expect-msg close-all net2o:gen-reset end-code
   884    875       net2o:close-all
   885    876       ." === sync done ===" forth:cr sync-done-xt ;
   886    877   event: :>msg-eval ( parent $pack $addr -- )
   887    878       { w^ buf w^ group }
   888    879       group $@ 2 64s /string { d: gname }
   889         -    gname ?msg-log
   890         -    gname msg-logs #@ nip cell/ u.
          880  +    gname >group
          881  +    msg-group-o .msg:log[] $[]# u.
   891    882       buf $@ true replay-mode ['] msg-eval !wrapper
   892    883       buf $free gname ?save-msg
   893    884       group $@ .chat-file ."  saved "
   894         -    gname msg-logs #@ nip cell/ u. forth:cr
          885  +    msg-group-o .msg:log[] $[]# u. forth:cr
   895    886       >o -1 file-count +!@ 1 =
   896    887       IF  gname chat-sync-done  THEN  group $free
   897    888       o> ;
   898    889   : msg-file-done ( -- )
   899    890       fs-path $@len IF
   900    891   	msg( ." msg file done: " fs-path $@ .chat-file forth:cr )
   901    892   	['] fs-flush file-sema c-section
................................................................................
   943    934   
   944    935   previous
   945    936   
   946    937   : ?destpk ( addr u -- addr' u' )
   947    938       2dup connection .pubkey $@ key| str= IF  2drop pk@ key|  THEN ;
   948    939   
   949    940   : last-signdate@ ( -- 64date )
   950         -    msg-group$ $@ msg-logs #@ dup IF
          941  +    msg-group-o .msg:log[] $@ dup IF
   951    942   	+ cell- $@ startdate@ 64#1 64+
   952    943       ELSE  2drop 64#-1  THEN ;
   953    944   
   954    945   also net2o-base
   955    946   : [msg,] ( xt -- )  last# >r
   956    947       msg-group$ $@ dup IF  message ?destpk 2dup >group $,
   957    948   	execute  end-with
................................................................................
   971    962       last-signdate@ 64#1 64+ lit, 64#-1 lit, ask-last# ulit, msg-last? ;
   972    963   
   973    964   : join, ( -- )
   974    965       [: msg-join sync-ahead?,
   975    966         sign[ msg-start "joined" $, msg-action msg-otr> ;] [msg,] ;
   976    967   
   977    968   : silent-join, ( -- )
   978         -    last# $@ dup IF  message $, msg-join  end-with
          969  +    msg-group$ $@ dup IF  message $, msg-join  end-with
   979    970       ELSE  2drop  THEN ;
   980    971   
   981    972   : leave, ( -- )
   982    973       [: msg-leave
   983    974         sign[ msg-start "left" $, msg-action msg-otr> ;] [msg,] ;
   984    975   
   985    976   : silent-leave, ( -- )
................................................................................
  1018   1009   : msg-tdisplay ( addr u -- )
  1019   1010       sigpksize# - 2dup + sigpksize# >$  c-state off
  1020   1011       nest-cmd-loop msg:end ;
  1021   1012   ' msg-tdisplay msg-class is msg:display
  1022   1013   ' msg-tdisplay msg-notify-class is msg:display
  1023   1014   : msg-tredisplay ( n -- )
  1024   1015       reset-time  0 otr-mode
  1025         -    [:  cells >r last# msg-log@ 2dup { log u }
         1016  +    [:  cells >r msg-log@ 2dup { log u }
  1026   1017   	dup r> - 0 max /string bounds ?DO
  1027   1018   	    I log - cell/ to log#
  1028   1019   	    I $@ { d: msgt }
  1029   1020   	    msgt ['] msg:display catch IF  ." invalid entry" cr
  1030   1021   		2drop  THEN
  1031   1022   	cell +LOOP
  1032   1023   	log free throw ;] !wrapper ;
................................................................................
  1054   1045   
  1055   1046   64Variable line-date 64#-1 line-date 64!
  1056   1047   Variable $lastline
  1057   1048   
  1058   1049   : !date ( addr u -- addr u )
  1059   1050       2dup + sigsize# - le-64@ line-date 64! ;
  1060   1051   : find-prev-chatline { maxlen addr -- max span addr span }
  1061         -    msg-group$ $@ ?msg-log
  1062         -    last# cell+ $[]# 0= IF  maxlen 0 addr over  EXIT  THEN
         1052  +    msg-group$ $@ >group
         1053  +    msg-group-o .msg:log[] $[]# 0= IF  maxlen 0 addr over  EXIT  THEN
  1063   1054       line-date 64@ date>i'
  1064         -    BEGIN  1- dup 0>= WHILE  dup last# cell+ $[]@
         1055  +    BEGIN  1- dup 0>= WHILE  dup msg-group-o .msg:log[] $[]@
  1065   1056   	dup sigpksize# - /string key| pk@ key| str=  UNTIL  THEN
  1066         -    last# cell+ $[]@ dup 0= IF  nip
         1057  +    msg-group-o .msg:log[] $[]@ dup 0= IF  nip
  1067   1058       ELSE  !date ['] msg:display textmsg-o .$tmp 
  1068   1059   	dup maxlen u> IF  dup >r maxlen 0 addr over r> grow-tib
  1069   1060   	    2drop to addr drop to maxlen  THEN
  1070   1061   	tuck addr maxlen smove
  1071   1062       THEN
  1072   1063       maxlen swap addr over ;
  1073   1064   : find-next-chatline { maxlen addr -- max span addr span }
  1074         -    msg-group$ $@ ?msg-log
         1065  +    msg-group$ $@ >group
  1075   1066       line-date 64@ date>i
  1076         -    BEGIN  1+ dup last# cell+ $[]# u< WHILE  dup last# cell+ $[]@
         1067  +    BEGIN  1+ dup msg-group-o .msg:log[] $[]# u< WHILE  dup msg-group-o .msg:log[] $[]@
  1077   1068   	dup sigpksize# - /string key| pk@ key| str=  UNTIL  THEN
  1078         -    dup last# cell+ $[]# u>=
         1069  +    dup msg-group-o .msg:log[] $[]# u>=
  1079   1070       IF    drop $lastline $@  64#-1 line-date 64!
  1080         -    ELSE  last# cell+ $[]@ !date ['] msg:display textmsg-o .$tmp  THEN
         1071  +    ELSE  msg-group-o .msg:log[] $[]@ !date ['] msg:display textmsg-o .$tmp  THEN
  1081   1072       dup maxlen u> IF  dup >r maxlen 0 addr over r> grow-tib
  1082   1073   	2drop to addr drop to maxlen  THEN
  1083   1074       tuck addr maxlen smove
  1084   1075       maxlen swap addr over ;
  1085   1076   
  1086   1077   : chat-prev-line  ( max span addr pos1 -- max span addr pos2 false )
  1087   1078       line-date 64@ 64#-1 64= IF
................................................................................
  1174   1165   also net2o-base
  1175   1166   \ chain messages to one previous message
  1176   1167   : chain, ( msgaddr u -- )
  1177   1168       [: 2dup startdate@ 64#0 { 64^ sd } sd le-64!  sd 1 64s forth:type
  1178   1169   	c:0key sigonly@ >hash hashtmp hash#128 forth:type ;] $tmp $, msg-chain ;
  1179   1170   
  1180   1171   : ?chain, ( -- )  chain-mode @ 0= ?EXIT
  1181         -    last# >r last# $@ ?msg-log
  1182         -    last# cell+ $[]# 1- dup 0< IF  drop
  1183         -    ELSE  last# cell+ $[]@ chain,
  1184         -    THEN  r> to last# ;
         1172  +    msg-group-o .msg:log[] $[]# 1- dup 0< IF  drop
         1173  +    ELSE  msg-group-o .msg:log[] $[]@ chain,
         1174  +    THEN ;
  1185   1175   
  1186   1176   : (send-avalanche) ( xt -- addr u flag )
  1187   1177       [: 0 >o [: sign[ msg-start execute ?chain, msg> ;] gen-cmd$ o>
  1188   1178         +last-signed msg-log, ;] [group] ;
  1189   1179   previous
  1190   1180   : send-avalanche ( xt -- )
  1191   1181       otr-mode @ IF  now>otr  ELSE  now>never  THEN
................................................................................
  1216   1206       ['] nick>chat arg-loop ;
  1217   1207   
  1218   1208   \ do otrify
  1219   1209   
  1220   1210   also net2o-base
  1221   1211   
  1222   1212   : do-otrify ( n -- ) >r
  1223         -    msg-group$ $@ ?msg-log last# cell+ $@ r> cells safe/string
         1213  +    msg-group$ $@ >group msg-group-o .msg:log[] $@ r> cells safe/string
  1224   1214       IF  $@ 2dup + sigpksize# - sigpksize#
  1225   1215   	over keysize pkc over str= IF
  1226   1216   	    keysize /string 2swap new-otrsig 2swap
  1227   1217   	    $, $, msg-otrify
  1228   1218   	ELSE
  1229   1219   	    2drop 2drop ." not your message!" forth:cr
  1230   1220   	THEN
................................................................................
  1379   1369   
  1380   1370   : /chats ( addr u -- ) 2drop ." ===== chats: "
  1381   1371       \U chats                list chats
  1382   1372       \G chats: list all chats
  1383   1373       [:  msg:name$ msg-group$ $@ str= IF ." *" THEN
  1384   1374   	msg:name$ .group
  1385   1375   	." [" msg:peers[] $[]# 0 .r ." ]#"
  1386         -	msg:name$ msg-logs #@ nip cell/ u. ;] group#map
         1376  +	msg:log[] $[]# u. ;] group#map
  1387   1377       ." =====" forth:cr ;
  1388   1378   
  1389   1379   : /nat ( addr u -- )  2drop
  1390   1380       \U nat                  list NAT info
  1391   1381       \G nat: list nat traversal information of all peers in all groups
  1392   1382       \U renat                redo NAT traversal
  1393   1383       \G renat: redo nat traversal
................................................................................
  1428   1418       \U n2o <cmd>            execute n2o command
  1429   1419       \G n2o: Execute normal n2o command
  1430   1420   
  1431   1421   : /sync ( addr u -- )
  1432   1422       \U sync [+date] [-date] synchronize logs
  1433   1423       \G sync: synchronize chat logs, starting and/or ending at specific
  1434   1424       \G sync: time/date
  1435         -    msg-group-o .msg:peers[] $@ 0= IF  drop  EXIT  THEN
  1436         -    @ >o o to connection
         1425  +    s>unumber? IF  drop  ELSE  2drop 0  THEN  cells >r
         1426  +    msg-group-o .msg:peers[] $@ r@ u<= IF  drop rdrop  EXIT  THEN
         1427  +    r> + @ >o o to connection
  1437   1428       ." === sync ===" forth:cr
  1438   1429       net2o-code expect-msg [: msg-group last?, ;] [msg,] end-code o> ;
  1439   1430   
  1440   1431   : /version ( addr u -- )
  1441   1432       \U version              version string
  1442   1433       \G version: print version string
  1443   1434       2drop .n2o-version space .gforth-version forth:cr ;
  1444   1435   
  1445   1436   : /log ( addr u -- )
  1446   1437       \U log [#lines]         show log
  1447   1438       \G log: show the log, default is a screenful
  1448   1439       s>unumber? IF  drop >r  ELSE  2drop rows >r  THEN
  1449         -    msg-group$ $@ ?msg-log purge-log
         1440  +    msg-group$ $@ >group purge-log
  1450   1441       r>  display-lastn ;
  1451   1442   
  1452   1443   : /logstyle ( addr u -- )
  1453   1444       \U logstyle [+-style]   set log style
  1454   1445       \G logstyle: set log styles, the following settings exist:
  1455   1446       \G logstyle: +date      a date per log line
  1456   1447       \G logstyle: +num       a message number per log line
................................................................................
  1546   1537   
  1547   1538   : avalanche-text ( addr u -- ) >utf8$
  1548   1539       [: parse-text ;] send-avalanche ;
  1549   1540   
  1550   1541   previous
  1551   1542   
  1552   1543   : load-msgn ( addr u n -- )
  1553         -    >r 2dup load-msg ?msg-log r> display-lastn ;
         1544  +    >r load-msg r> display-lastn ;
  1554   1545   
  1555   1546   : +group ( -- ) msg-group$ $@ >group +unique-con ;
  1556   1547   
  1557   1548   : msg-timeout ( -- )
  1558   1549       packets2 @  connected-timeout  packets2 @ <>
  1559   1550       IF  reply( ." Resend to " pubkey $@ key>nick type cr )
  1560   1551   	timeout-expired? IF
................................................................................
  1615   1606         ELSE  nip nip  THEN ;] $[]map ;
  1616   1607   
  1617   1608   : key>group ( addr u -- pk u )
  1618   1609       @/ 2swap tuck msg-group$ $!  0=
  1619   1610       IF  2dup key| msg-group$ $!  THEN ; \ 1:1 chat-group=key
  1620   1611   
  1621   1612   : ?load-msgn ( -- )
  1622         -    msg-group$ $@ msg-logs #@ d0= IF
         1613  +    msg-group$ $@ >group msg-group-o .msg:log[] $@len 0= IF
  1623   1614   	msg-group$ $@ rows load-msgn  THEN ;
  1624   1615   
  1625   1616   : chat-connects ( -- )
  1626   1617       chat-keys [: key>group ?load-msgn
  1627   1618         dup 0= IF  2drop msg-group$ $@ >group  EXIT  THEN
  1628   1619         2dup search-connect ?dup-IF  >o +group greet o> 2drop EXIT  THEN
  1629   1620         2dup pk-peek?  IF  chat-connect  ELSE  2drop  THEN ;] $[]map ;
................................................................................
  1736   1727       REPEAT  2drop leave-chats  xchar-history
  1737   1728       nr> set-order ;
  1738   1729   
  1739   1730   : avalanche-to ( addr u o:context -- )
  1740   1731       avalanche( ." Send avalanche to: " pubkey $@ key>nick type space over hex. cr )
  1741   1732       o to connection
  1742   1733       net2o-code expect-msg message
  1743         -    last# $@ 2dup pubkey $@ key| str= IF  2drop  ELSE  group,  THEN
         1734  +    msg-group-o .msg:name$ 2dup pubkey $@ key| str= IF  2drop  ELSE  group,  THEN
  1744   1735       $, nestsig end-with
  1745   1736       end-code ;
  1746   1737   
  1747   1738   \\\
  1748   1739   Local Variables:
  1749   1740   forth-local-words:
  1750   1741       (

Changes to vault.fs.

   102    102   
   103    103   $80 Constant min-align#
   104    104   $400 Constant pow-align#
   105    105   
   106    106   : vault-aligned ( len -- len' )
   107    107       \G Align vault to minimum granularity plus relative alignment
   108    108       \G to hide the actual file-size
   109         -    1- 0 >r  BEGIN  dup pow-align# u>  WHILE  2/ r> 1+ >r  REPEAT
          109  +    1- 0 >r  BEGIN  dup pow-align# u>  WHILE  1 rshift r> 1+ >r  REPEAT
   110    110       1+ r> lshift  min-align# 1- + min-align# negate and ;
   111    111   
   112    112   Variable enc-mode
   113    113   
   114    114   : enc-keccak ( -- )        $60 enc-mode ! ; \ wrap with keccak
   115    115   : enc-threefish ( -- ) $010160 enc-mode ! ; \ wrap with threefish
   116    116   : enc>crypt2 ( -- )