Index: cmd.fs ================================================================== --- cmd.fs +++ cmd.fs @@ -707,15 +707,14 @@ 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 - ." tmpnest failed, uncmd" forth:cr - net2o:see-me 2drop un-cmd THEN - ELSE 2drop 2drop un-cmd THEN ; + IF tmp-crypt-val do-nest EXIT THEN + cmd( ." tmpnest failed, uncmd" 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 ." encnest failed, uncmd" forth:cr Index: dvcs.fs ================================================================== --- dvcs.fs +++ dvcs.fs @@ -611,18 +611,18 @@ : 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 + 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 ; + 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 -- ) @@ -673,11 +673,11 @@ }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 } + 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 @@ -860,15 +860,15 @@ 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 + 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:project$ $@ @/ 2drop >group project:branch$ $@ dvcs:searchs @ >o match:tag$ $! chat>searchs-loop match:id$ $@ o> ; : dvcs-up ( -- ) \ checkout latest revision @@ -983,11 +983,11 @@ /sync-files +LOOP /sync-reqs +LOOP ; : dvcs-data-sync ( -- ) sync-file-list[] $[]off branches[] $[]off - msg-group$ $@ ?msg-log + 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 ; Index: msg.fs ================================================================== --- msg.fs +++ msg.fs @@ -30,23 +30,18 @@ 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 + { d: msgx } + msg-group-o .msg:peers[] $@ + bounds ?DO I @ o <> IF msgx 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[] @@ -61,15 +56,15 @@ 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 ; +: msg-log@ ( -- addr u ) + [: msg-group-o .msg:log[] $@ save-mem ;] msglog-sema c-section ; : purge-log ( -- ) - [: last# cell+ { a[] } + [: 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 @@ -85,16 +80,16 @@ gen-cmd ; Variable saved-msg$ 64Variable saved-msg-ticks -: save-msgs ( last -- ) +: save-msgs ( group-o -- ) to msg-group-o msg( ." Save messages" cr ) ?.net2o/chats net2o:new-msging >o - dup msg-log@ over >r serialize-log enc-file $!buf + msg-log@ over >r serialize-log enc-file $!buf r> free throw dispose o> - $@ >chatid .chats/ enc-filename $! + 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 ; @@ -121,45 +116,41 @@ ?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-msgs ( group-o -- ) saved-msg$ +unique$ ; event: :>save-all-msgs ( -- ) save-all-msgs ; -event: :>load-msg ( last# -- ) - $@ load-msg ; +event: :>load-msg ( group-o -- ) + .msg:name$ load-msg ; : >load-group ( group u -- ) - 2dup msg-logs #@ d0= >r >group r> - IF load-msg + >group msg-group-o .msg:log[] $@len 0= + IF load-msg parent .wait-task @ dup 0= IF drop ?file-task THEN event> THEN ; : !save-all-msgs ( -- ) syncfile( save-all-msgs )else( save-all-msgs ?file-task event| ) ; : save-msgs& ( -- ) syncfile( last# saved-msg$ +unique$ )else( - save-msgs ?file-task event> ) ; - -: ?msg-log ( addr u -- ) msg-logs ?hash ; + save-msgs ?file-task event> ) ; 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! + [: 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 -- ) - ?msg-log - last# otr-mode @ replay-mode @ or 0= and - IF save-msgs& THEN ; + >group + otr-mode @ replay-mode @ or 0= IF save-msgs& THEN ; Sema queue-sema \ peer queue, in msg context @@ -180,11 +171,11 @@ : 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> ; + msg-group-o .msg:redisplay ; : display-sync-done ( -- ) rows msg-group-o .msg:redisplay ; : display-one-msg { d: msgt -- } msg-group-o >o @@ -319,19 +310,19 @@ >r r@ msg-nestsig r> event> ELSE do-msg-nestsig THEN ; : date>i ( date -- i ) - last# cell+ $search[]date last# cell+ $[]# 1- umin ; + msg-group-o .msg:log[] $search[]date msg-group-o .msg:log[] $[]# 1- umin ; : date>i' ( date -- i ) - last# cell+ $search[]date last# cell+ $[]# umin ; + 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 last# cell+ $[]@ sigonly@ >hash + 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 ; @@ -448,11 +439,11 @@ :noname ( addr u -- ) last# >r key| 2dup 0 .pk@ key| str= IF THEN ." @" .key-id? r> to last# ; msg-class is msg:signal :noname ( addr u -- ) - last# >r last# $@ ?msg-log + last# >r last# $@ >group 2dup sighash? IF ELSE THEN ." <" over le-64@ .ticks verbose( dup keysize - /string ." ," 85type )else( 2drop ) r> to last# ; msg-class is msg:chain :noname ( addr u -- ) @@ -499,19 +490,19 @@ 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 + 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 last# cell+ $[]@ + 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 last# cell+ $[]@ replace-sig + sig u' I msg-group-o .msg:log[] $[]@ replace-sig save-msgs& ELSE ." [OTRified] #" I u. THEN ELSE @@ -754,42 +745,42 @@ User hashtmp$ hashtmp$ off : last-msg@ ( -- ticks ) last# >r - last# $@ ?msg-log last# cell+ $[]# ?dup-IF - 1- last# cell+ $[]@ startdate@ + 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 - last# cell+ $[]# IF - [: U+DO I last# cell+ $[]@ 1- dup 1 64s - safe/string forth:type + 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 -- ) - last# cell+ $[]@ startdate@ 64#0 { 64^ x } + msg-group-o .msg:log[] $[]@ startdate@ 64#0 { 64^ x } x le-64! x 1 64s forth:type ; : i.date+1 ( i -- ) - last# cell+ $[]@ startdate@ 64#0 { 64^ x } + 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# $@ ?msg-log purge-log - last# cell+ $[]# + 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 last# cell+ $[]# u< IF i.date + 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 @@ -821,11 +812,11 @@ 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 + 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@ @@ -859,12 +850,12 @@ 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 $@ 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 @@ -877,23 +868,23 @@ ; 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 + >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 ?msg-log - gname msg-logs #@ nip cell/ u. + gname >group + msg-group-o .msg:log[] $[]# 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 + 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 @@ -945,11 +936,11 @@ : ?destpk ( addr u -- addr' u' ) 2dup connection .pubkey $@ key| str= IF 2drop pk@ key| THEN ; : last-signdate@ ( -- 64date ) - msg-group$ $@ msg-logs #@ dup IF + msg-group-o .msg:log[] $@ dup IF + cell- $@ startdate@ 64#1 64+ ELSE 2drop 64#-1 THEN ; also net2o-base : [msg,] ( xt -- ) last# >r @@ -973,11 +964,11 @@ : join, ( -- ) [: msg-join sync-ahead?, sign[ msg-start "joined" $, msg-action msg-otr> ;] [msg,] ; : silent-join, ( -- ) - last# $@ dup IF message $, msg-join end-with + msg-group$ $@ dup IF message $, msg-join end-with ELSE 2drop THEN ; : leave, ( -- ) [: msg-leave sign[ msg-start "left" $, msg-action msg-otr> ;] [msg,] ; @@ -1020,11 +1011,11 @@ 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 } + [: 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 @@ -1056,30 +1047,30 @@ 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 + 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 last# cell+ $[]@ + BEGIN 1- dup 0>= WHILE dup msg-group-o .msg:log[] $[]@ dup sigpksize# - /string key| pk@ key| str= UNTIL THEN - last# cell+ $[]@ dup 0= IF nip + 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$ $@ ?msg-log + msg-group$ $@ >group line-date 64@ date>i - BEGIN 1+ dup last# cell+ $[]# u< WHILE dup last# cell+ $[]@ + 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 last# cell+ $[]# u>= + dup msg-group-o .msg:log[] $[]# u>= IF drop $lastline $@ 64#-1 line-date 64! - ELSE last# cell+ $[]@ !date ['] msg:display textmsg-o .$tmp THEN + 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 ; @@ -1176,14 +1167,13 @@ : 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# ; + 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 @@ -1218,11 +1208,11 @@ \ do otrify also net2o-base : do-otrify ( n -- ) >r - msg-group$ $@ ?msg-log last# cell+ $@ r> cells safe/string + 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 @@ -1381,11 +1371,11 @@ \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 + 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 @@ -1430,12 +1420,13 @@ : /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 + 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 @@ -1444,11 +1435,11 @@ : /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 + 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: @@ -1548,11 +1539,11 @@ [: parse-text ;] send-avalanche ; previous : load-msgn ( addr u n -- ) - >r 2dup load-msg ?msg-log r> display-lastn ; + >r load-msg r> display-lastn ; : +group ( -- ) msg-group$ $@ >group +unique-con ; : msg-timeout ( -- ) packets2 @ connected-timeout packets2 @ <> @@ -1617,11 +1608,11 @@ : 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$ $@ >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 @@ -1738,11 +1729,11 @@ : 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 + msg-group-o .msg:name$ 2dup pubkey $@ key| str= IF 2drop ELSE group, THEN $, nestsig end-with end-code ; \\\ Local Variables: Index: vault.fs ================================================================== --- vault.fs +++ vault.fs @@ -104,11 +104,11 @@ $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- 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