Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | Replace msg-logs by msg:log[] |
---|---|
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
2326543d3ad938bb63bc099a3f314e4b |
User & Date: | bernd 2019-06-20 22:13:20.990 |
Context
2019-06-21
| ||
12:43 | More fixes for chat structure check-in: 557d941bc0 user: bernd tags: trunk | |
2019-06-20
| ||
22:13 | Replace msg-logs by msg:log[] check-in: 2326543d3a user: bernd tags: trunk | |
19:45 | /sync bug fixed check-in: 35e82dc6d7 user: bernd tags: trunk | |
Changes
Changes to cmd.fs.
︙ | ︙ | |||
705 706 707 708 709 710 711 | IF own-crypt-val do-nest ELSE <err> ." cmdnest: no owncrypt, un-cmd" <default> forth:cr un-cmd THEN ; : cmdtmpnest ( addr u -- ) $>align tmpkey@ key| dup IF key( ." tmpnest key: " 2dup 85type forth:cr ) decrypt$ | | < | | | | 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 | IF own-crypt-val do-nest ELSE <err> ." cmdnest: no owncrypt, un-cmd" <default> forth:cr un-cmd THEN ; : cmdtmpnest ( addr u -- ) $>align tmpkey@ key| dup IF key( ." tmpnest key: " 2dup 85type forth:cr ) decrypt$ IF tmp-crypt-val do-nest EXIT THEN cmd( <err> ." tmpnest failed, uncmd" <default> forth:cr net2o:see-me ) ELSE 2drop THEN 2drop un-cmd ; : cmdencnest ( addr u -- ) $>align tmpkey@ dup IF key( ." encnest key: " 2dup 85type forth:cr ) decrypt$ IF enc-crypt-val do-nest [ qr-tmp-val invert ]L validated and! ELSE <err> ." encnest failed, uncmd" <default> forth:cr 2drop un-cmd THEN ELSE <err> ." encnest: no tmpkey" <default> forth:cr |
︙ | ︙ |
Changes to dvcs.fs.
︙ | ︙ | |||
609 610 611 612 613 614 615 | ' drop dvcs-log-class is msg:redisplay : chat>dvcs ( o:dvcs -- ) project:project$ $@ @/ 2drop load-msg ; : .hash ( addr -- ) [: dup $@ 85type ." -> " cell+ $@ 85type cr ;] #map ; : chat>branches-loop ( o:commit -- ) | | | | 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 | ' drop dvcs-log-class is msg:redisplay : chat>dvcs ( o:dvcs -- ) project:project$ $@ @/ 2drop load-msg ; : .hash ( addr -- ) [: dup $@ 85type ." -> " cell+ $@ 85type cr ;] #map ; : chat>branches-loop ( o:commit -- ) msg-log@ over { log } bounds ?DO re$ $free object$ $free I $@ ['] msg:display catch IF ." invalid entry" cr 2drop THEN cell +LOOP log free throw dvcs( ." === id>patch ===" cr id>patch# .hash ." === id>snap ===" cr id>snap# .hash ) ; : chat>branches ( o:dvcs -- ) project:project$ $@ @/ 2drop >group dvcs:commits @ .chat>branches-loop ; : >branches ( addr u -- ) $make branches[] >back ; User id-check# \ check hash : id>branches-loop ( addr u -- ) BEGIN 2dup id-check# #@ d0<> IF 2drop EXIT THEN s" !" 2over id-check# #! |
︙ | ︙ | |||
671 672 673 674 675 676 677 | : dispose-dvcs-log ( o:log -- ) clear-log dispose ; }scope : display-logn ( addr u n -- ) project:branch$ $@ { d: branch } dvcs:new-dvcs-log >o | | | 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 | : dispose-dvcs-log ( o:log -- ) clear-log dispose ; }scope : display-logn ( addr u n -- ) project:branch$ $@ { d: branch } dvcs:new-dvcs-log >o cells >r >group msg-log@ 2dup { log u } dup r> - 0 max dup >r /string r> cell/ -rot bounds ?DO dvcs:clear-log I $@ ['] msg:display catch IF ." invalid entry" cr 2drop ELSE branch dvcs-log:tag$ $@ str= IF dup 0 .r ." : [" dvcs-log:id$ $@ 85type ." ] " dvcs-log:sig$ $@ 2dup startdate@ .ticks |
︙ | ︙ | |||
858 859 860 861 862 863 864 | : dvcs-co ( addr u -- ) \ checkout revision base85>$ dvcs:new-dvcs >o config>dvcs dvcs:id$ $! dvcs:id$ dvcs-readin co-rest dvcs:dispose-dvcs o> ; : chat>searchs-loop ( o:commit -- ) | | | | 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 | : dvcs-co ( addr u -- ) \ checkout revision base85>$ dvcs:new-dvcs >o config>dvcs dvcs:id$ $! dvcs:id$ dvcs-readin co-rest dvcs:dispose-dvcs o> ; : chat>searchs-loop ( o:commit -- ) msg-log@ over { log } bounds ?DO I $@ ['] msg:display catch IF ." invalid entry" cr 2drop THEN cell +LOOP log free throw ; : search-last-rev ( -- addr u ) project:project$ $@ @/ 2drop >group project:branch$ $@ dvcs:searchs @ >o match:tag$ $! chat>searchs-loop match:id$ $@ o> ; : dvcs-up ( -- ) \ checkout latest revision dvcs:new-dvcs >o pull-readin files>dvcs new>dvcs dvcs?modified |
︙ | ︙ | |||
981 982 983 984 985 986 987 | THEN \ ELSE end-code THEN /sync-files +LOOP /sync-reqs +LOOP ; : dvcs-data-sync ( -- ) sync-file-list[] $[]off branches[] $[]off | | | 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 | THEN \ ELSE end-code THEN /sync-files +LOOP /sync-reqs +LOOP ; : dvcs-data-sync ( -- ) sync-file-list[] $[]off branches[] $[]off msg-group$ $@ >group dvcs:commits @ .chat>branches-loop dvcs:commits @ .dvcs-needed-files sync-file-list[] $[]# 0> connection and IF sync-file-list[] connection .get-needed-files THEN ; : dvcs-ref-sync ( -- ) search-last-rev id>branches |
︙ | ︙ |
Changes to msg.fs.
︙ | ︙ | |||
28 29 30 31 32 33 34 | 2dup msg-group# #@ d0= IF net2o:new-msg >o 2dup to msg:name$ o o> cell- [ msg-class >osize @ cell+ ]L 2over msg-group# #! THEN last# cell+ $@ drop cell+ to msg-group-o 2drop ; | < < | | | < < < | | | | | | | 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 | 2dup msg-group# #@ d0= IF net2o:new-msg >o 2dup to msg:name$ o o> cell- [ msg-class >osize @ cell+ ]L 2over msg-group# #! THEN last# cell+ $@ drop cell+ to msg-group-o 2drop ; : avalanche-msg ( msg u1 o:connect -- ) \G forward message to all next nodes of that message group { d: msgx } msg-group-o .msg:peers[] $@ bounds ?DO I @ o <> IF msgx I @ .avalanche-to THEN cell +LOOP ; Variable msg-group$ Variable otr-mode Variable chain-mode Variable redate-mode Variable lock-mode Variable msg-keys[] User replay-mode User skip-sig? Sema msglog-sema : ?msg-context ( -- o ) msging-context @ dup 0= IF drop net2o:new-msging dup msging-context ! THEN ; : >chatid ( group u -- id u ) defaultkey sec@ keyed-hash#128 ; : msg-log@ ( -- addr u ) [: msg-group-o .msg:log[] $@ save-mem ;] msglog-sema c-section ; : purge-log ( -- ) [: msg-group-o .msg:log[] { a[] } 0 BEGIN dup a[] $[]# u< WHILE dup a[] $[]@ check-date nip nip IF dup a[] $[] $free a[] over cells cell $del ELSE 1+ THEN REPEAT drop ;] msglog-sema c-section ; : serialize-log ( addr u -- $addr ) [: bounds ?DO I $@ check-date 0= IF net2o-base:$, net2o-base:nestsig ELSE 2drop THEN cell +LOOP ;] gen-cmd ; Variable saved-msg$ 64Variable saved-msg-ticks : save-msgs ( group-o -- ) to msg-group-o msg( ." Save messages" cr ) ?.net2o/chats net2o:new-msging >o msg-log@ over >r serialize-log enc-file $!buf r> free throw dispose o> msg-group-o .msg:name$ >chatid .chats/ enc-filename $! pk-off key-list encfile-rest ; : save-all-msgs ( -- ) saved-msg$ $@ bounds ?DO I @ save-msgs cell +LOOP saved-msg$ $free ; : save-msgs? ( -- ) |
︙ | ︙ | |||
119 120 121 122 123 124 125 | \ try read backup instead [: enc-filename $. '~' emit ;] $tmp ['] decrypt@ catch ?dup-IF DoError 2drop ELSE msg-eval THEN ELSE msg-eval THEN replay-mode off skip-sig? off enc-file $free ; | | | | | | | < < < | | | | < | 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 | \ try read backup instead [: enc-filename $. '~' emit ;] $tmp ['] decrypt@ catch ?dup-IF DoError 2drop ELSE msg-eval THEN ELSE msg-eval THEN replay-mode off skip-sig? off enc-file $free ; event: :>save-msgs ( group-o -- ) saved-msg$ +unique$ ; event: :>save-all-msgs ( -- ) save-all-msgs ; event: :>load-msg ( group-o -- ) .msg:name$ load-msg ; : >load-group ( group u -- ) >group msg-group-o .msg:log[] $@len 0= IF <event msg-group-o elit, :>load-msg parent .wait-task @ dup 0= IF drop ?file-task THEN event> THEN ; : !save-all-msgs ( -- ) syncfile( save-all-msgs )else( <event :>save-all-msgs ?file-task event| ) ; : save-msgs& ( -- ) syncfile( last# saved-msg$ +unique$ )else( <event msg-group-o elit, :>save-msgs ?file-task event> ) ; 0 Value log# 2Variable last-msg : +msg-log ( addr u -- addr' u' / 0 0 ) [: msg-group-o .msg:log[] $ins[]date dup dup 0< xor to log# log# msg-group-o .msg:log[] $[]@ last-msg 2! 0< IF #0. ELSE last-msg 2@ THEN ;] msglog-sema c-section ; : ?save-msg ( addr u -- ) >group otr-mode @ replay-mode @ or 0= IF save-msgs& THEN ; Sema queue-sema \ peer queue, in msg context : peer> ( -- addr / 0 ) [: msg:peers[] back> ;] queue-sema c-section ; |
︙ | ︙ | |||
178 179 180 181 182 183 184 | last# >r +msg-log last# ?dup-IF $@ ?save-msg THEN r> to last# ; : do-msg-nestsig ( addr u -- ) 2dup msg-group-o .msg:display msg-notify-o .msg:display ; : display-lastn ( n -- ) | | | 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 | last# >r +msg-log last# ?dup-IF $@ ?save-msg THEN r> to last# ; : do-msg-nestsig ( addr u -- ) 2dup msg-group-o .msg:display msg-notify-o .msg:display ; : display-lastn ( n -- ) msg-group-o .msg:redisplay ; : display-sync-done ( -- ) rows msg-group-o .msg:redisplay ; : display-one-msg { d: msgt -- } msg-group-o >o msgt ['] msg:display catch IF ." invalid entry" cr 2drop THEN o> ; |
︙ | ︙ | |||
317 318 319 320 321 322 323 | parent dup IF .wait-task @ dup up@ <> and THEN ?dup-IF >r r@ <hide> <event $make elit, o elit, last# elit, :>msg-nestsig r> event> ELSE do-msg-nestsig THEN ; : date>i ( date -- i ) | | | | | 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 | parent dup IF .wait-task @ dup up@ <> and THEN ?dup-IF >r r@ <hide> <event $make elit, o elit, last# elit, :>msg-nestsig r> event> ELSE do-msg-nestsig THEN ; : date>i ( date -- i ) msg-group-o .msg:log[] $search[]date msg-group-o .msg:log[] $[]# 1- umin ; : date>i' ( date -- i ) msg-group-o .msg:log[] $search[]date msg-group-o .msg:log[] $[]# umin ; : sighash? ( addr u -- flag ) over le-64@ date>i dup 0< IF drop 2drop false EXIT THEN >r over le-64@ 64#1 64+ date>i' >r [ 1 64s ]L /string r> r> U+DO c:0key I msg-group-o .msg:log[] $[]@ sigonly@ >hash 2dup hashtmp over str= IF 2drop true UNLOOP EXIT ELSE ( 2dup 85type ." <> " hashtmp over 85type ) THEN LOOP 2drop false ; : msg-key! ( addr u -- ) 0 msg-keys[] [: rot >r 2over str= r> or ;] $[]map |
︙ | ︙ | |||
446 447 448 449 450 451 452 | :noname ( addr u -- ) $utf8> <warn> '#' forth:emit .group <default> ; msg-class is msg:tag :noname ( addr u -- ) last# >r key| 2dup 0 .pk@ key| str= IF <err> THEN ." @" .key-id? <default> r> to last# ; msg-class is msg:signal :noname ( addr u -- ) | | | 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 | :noname ( addr u -- ) $utf8> <warn> '#' forth:emit .group <default> ; msg-class is msg:tag :noname ( addr u -- ) last# >r key| 2dup 0 .pk@ key| str= IF <err> THEN ." @" .key-id? <default> r> to last# ; msg-class is msg:signal :noname ( addr u -- ) last# >r last# $@ >group 2dup sighash? IF <info> ELSE <err> THEN ." <" over le-64@ .ticks verbose( dup keysize - /string ." ," 85type )else( 2drop ) <default> r> to last# ; msg-class is msg:chain :noname ( addr u -- ) space <warn> ." [" 85type ." ]->" <default> ; msg-class is msg:re :noname ( addr u -- ) |
︙ | ︙ | |||
497 498 499 500 501 502 503 | 2dup pk-sig? !!sig!! 2drop addrmsg umsg smove ; : new-otrsig ( addr u -- addrsig usig ) 2dup startdate@ old>otr c:0key sigpksize# - c:hash ['] .sig $tmp 1 64s /string ; :noname { sig u' addr u -- } u' 64'+ u = u sigsize# = and IF | | | | | 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 | 2dup pk-sig? !!sig!! 2drop addrmsg umsg smove ; : new-otrsig ( addr u -- addrsig usig ) 2dup startdate@ old>otr c:0key sigpksize# - c:hash ['] .sig $tmp 1 64s /string ; :noname { sig u' addr u -- } u' 64'+ u = u sigsize# = and IF last# >r last# $@ >group addr u startdate@ 64dup date>i >r 64#1 64+ date>i' r> 2dup = IF ." [otrified] " addr u startdate@ .ticks THEN U+DO I msg-group-o .msg:log[] $[]@ 2dup dup sigpksize# - /string key| msg:id$ str= IF dup u - /string addr u str= IF ." OTRify #" I u. sig u' I msg-group-o .msg:log[] $[]@ replace-sig save-msgs& ELSE ." [OTRified] #" I u. THEN ELSE 2drop THEN |
︙ | ︙ | |||
752 753 754 755 756 757 758 | : expect-msg ( o:connection -- ) reply( ['] msg-reply )else( ['] drop ) expect-reply-xt +chat-control ; User hashtmp$ hashtmp$ off : last-msg@ ( -- ticks ) last# >r | | | | | | | | | | | 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 | : expect-msg ( o:connection -- ) reply( ['] msg-reply )else( ['] drop ) expect-reply-xt +chat-control ; User hashtmp$ hashtmp$ off : last-msg@ ( -- ticks ) last# >r last# $@ >group msg-group-o .msg:log[] $[]# ?dup-IF 1- msg-group-o .msg:log[] $[]@ startdate@ ELSE 64#0 THEN r> to last# ; : l.hashs ( end start -- hashaddr u ) hashtmp$ $off msg-group-o .msg:log[] $[]# IF [: U+DO I msg-group-o .msg:log[] $[]@ 1- dup 1 64s - safe/string forth:type LOOP ;] hashtmp$ $exec hashtmp$ $@ \ [: 2dup dump ;] stderr outfile-execute \ dump hash inputs ELSE 2drop s" " THEN \ we have nothing yet >file-hash 1 64s umin ; : i.date ( i -- ) msg-group-o .msg:log[] $[]@ startdate@ 64#0 { 64^ x } x le-64! x 1 64s forth:type ; : i.date+1 ( i -- ) msg-group-o .msg:log[] $[]@ startdate@ 64#0 { 64^ x } 64#1 64+ x le-64! x 1 64s forth:type ; : last-msgs@ ( startdate enddate n -- addr u n' ) \G print n intervals for messages from startdate to enddate \G The intervals contain the same size of messages except the \G last one, which may contain less (rounding down). \G Each interval contains a 64 bit hash of the last 64 bit of \G each message within the interval last# >r >r last# $@ >group purge-log msg-group-o .msg:log[] $[]# IF date>i' >r date>i' r> swap 2dup - r> over >r 1- 1 max / 0 max 1+ -rot [: over >r U+DO I i.date dup I + I' umin I l.hashs forth:type dup +LOOP r> dup msg-group-o .msg:log[] $[]# u< IF i.date ELSE 1- i.date+1 THEN drop ;] $tmp r> \ over 1 64s u> - ELSE rdrop 64drop 64drop s" " 0 THEN r> to last# ; \ sync chatlog through virtual file access termserver-class class |
︙ | ︙ | |||
819 820 821 822 823 824 825 | : msg:last? ( start end n -- ) last# $@ $, msg-group max-last# umin last-msgs@ >r $, r> ulit, msg-last ; : ?ask-msg-files ( addr u -- ) 64#-1 64#0 { 64^ startd 64^ endd } \ byte order of 0 and -1 don't matter | | | 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 | : msg:last? ( start end n -- ) last# $@ $, msg-group max-last# umin last-msgs@ >r $, r> ulit, msg-last ; : ?ask-msg-files ( addr u -- ) 64#-1 64#0 { 64^ startd 64^ endd } \ byte order of 0 and -1 don't matter last# $@ >group $> bounds ?DO I' I 64'+ u> IF I le-64@ date>i' I 64'+ 64'+ le-64@ date>i' swap l.hashs drop le-64@ I 64'+ le-64@ 64<> IF I 64@ startd le-64@ 64umin |
︙ | ︙ | |||
857 858 859 860 861 862 863 | parent .sync-none-xt \ sync-nothing-xt??? THEN r> to last# ; :noname ( -- 64len ) \ poll serializes the fs-outbuf $off | | | | | | | | 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 | parent .sync-none-xt \ sync-nothing-xt??? THEN r> to last# ; :noname ( -- 64len ) \ poll serializes the fs-outbuf $off fs-path $@ 2 64s /string >group msg-log@ over >r fs-path $@ drop le-64@ date>i \ start index fs-path $@ drop 64'+ le-64@ 64#1 64+ date>i' \ end index over - >r cells safe/string r> cells umin req? @ >r req? off serialize-log r> req? ! fs-outbuf $!buf r> free throw fs-outbuf $@len u>64 ; msgfs-class is fs-poll :noname ( addr u mode -- ) \G addr u is starttick endtick name concatenated together fs-close drop fs-path $! fs-poll fs-size! ['] noop is file-xt ; msgfs-class is fs-open \ syncing done : chat-sync-done ( group-addr u -- ) msg( ." chat-sync-done " 2dup forth:type forth:cr ) >group display-sync-done !save-all-msgs net2o-code expect-msg close-all net2o:gen-reset end-code net2o:close-all ." === sync done ===" forth:cr sync-done-xt ; event: :>msg-eval ( parent $pack $addr -- ) { w^ buf w^ group } group $@ 2 64s /string { d: gname } gname >group msg-group-o .msg:log[] $[]# u. buf $@ true replay-mode ['] msg-eval !wrapper buf $free gname ?save-msg group $@ .chat-file ." saved " msg-group-o .msg:log[] $[]# u. forth:cr >o -1 file-count +!@ 1 = IF gname chat-sync-done THEN group $free o> ; : msg-file-done ( -- ) fs-path $@len IF msg( ." msg file done: " fs-path $@ .chat-file forth:cr ) ['] fs-flush file-sema c-section |
︙ | ︙ | |||
943 944 945 946 947 948 949 | previous : ?destpk ( addr u -- addr' u' ) 2dup connection .pubkey $@ key| str= IF 2drop pk@ key| THEN ; : last-signdate@ ( -- 64date ) | | | 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 | previous : ?destpk ( addr u -- addr' u' ) 2dup connection .pubkey $@ key| str= IF 2drop pk@ key| THEN ; : last-signdate@ ( -- 64date ) msg-group-o .msg:log[] $@ dup IF + cell- $@ startdate@ 64#1 64+ ELSE 2drop 64#-1 THEN ; also net2o-base : [msg,] ( xt -- ) last# >r msg-group$ $@ dup IF message ?destpk 2dup >group $, execute end-with |
︙ | ︙ | |||
971 972 973 974 975 976 977 | last-signdate@ 64#1 64+ lit, 64#-1 lit, ask-last# ulit, msg-last? ; : join, ( -- ) [: msg-join sync-ahead?, sign[ msg-start "joined" $, msg-action msg-otr> ;] [msg,] ; : silent-join, ( -- ) | | | 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 | last-signdate@ 64#1 64+ lit, 64#-1 lit, ask-last# ulit, msg-last? ; : join, ( -- ) [: msg-join sync-ahead?, sign[ msg-start "joined" $, msg-action msg-otr> ;] [msg,] ; : silent-join, ( -- ) msg-group$ $@ dup IF message $, msg-join end-with ELSE 2drop THEN ; : leave, ( -- ) [: msg-leave sign[ msg-start "left" $, msg-action msg-otr> ;] [msg,] ; : silent-leave, ( -- ) |
︙ | ︙ | |||
1018 1019 1020 1021 1022 1023 1024 | : msg-tdisplay ( addr u -- ) sigpksize# - 2dup + sigpksize# >$ c-state off nest-cmd-loop msg:end ; ' msg-tdisplay msg-class is msg:display ' msg-tdisplay msg-notify-class is msg:display : msg-tredisplay ( n -- ) reset-time 0 otr-mode | | | 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 | : msg-tdisplay ( addr u -- ) sigpksize# - 2dup + sigpksize# >$ c-state off nest-cmd-loop msg:end ; ' msg-tdisplay msg-class is msg:display ' msg-tdisplay msg-notify-class is msg:display : msg-tredisplay ( n -- ) reset-time 0 otr-mode [: cells >r msg-log@ 2dup { log u } dup r> - 0 max /string bounds ?DO I log - cell/ to log# I $@ { d: msgt } msgt ['] msg:display catch IF ." invalid entry" cr 2drop THEN cell +LOOP log free throw ;] !wrapper ; |
︙ | ︙ | |||
1054 1055 1056 1057 1058 1059 1060 | 64Variable line-date 64#-1 line-date 64! Variable $lastline : !date ( addr u -- addr u ) 2dup + sigsize# - le-64@ line-date 64! ; : find-prev-chatline { maxlen addr -- max span addr span } | | | | | | | | | | 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 | 64Variable line-date 64#-1 line-date 64! Variable $lastline : !date ( addr u -- addr u ) 2dup + sigsize# - le-64@ line-date 64! ; : find-prev-chatline { maxlen addr -- max span addr span } msg-group$ $@ >group msg-group-o .msg:log[] $[]# 0= IF maxlen 0 addr over EXIT THEN line-date 64@ date>i' BEGIN 1- dup 0>= WHILE dup msg-group-o .msg:log[] $[]@ dup sigpksize# - /string key| pk@ key| str= UNTIL THEN msg-group-o .msg:log[] $[]@ dup 0= IF nip ELSE !date ['] msg:display textmsg-o .$tmp dup maxlen u> IF dup >r maxlen 0 addr over r> grow-tib 2drop to addr drop to maxlen THEN tuck addr maxlen smove THEN maxlen swap addr over ; : find-next-chatline { maxlen addr -- max span addr span } msg-group$ $@ >group line-date 64@ date>i BEGIN 1+ dup msg-group-o .msg:log[] $[]# u< WHILE dup msg-group-o .msg:log[] $[]@ dup sigpksize# - /string key| pk@ key| str= UNTIL THEN dup msg-group-o .msg:log[] $[]# u>= IF drop $lastline $@ 64#-1 line-date 64! ELSE msg-group-o .msg:log[] $[]@ !date ['] msg:display textmsg-o .$tmp THEN dup maxlen u> IF dup >r maxlen 0 addr over r> grow-tib 2drop to addr drop to maxlen THEN tuck addr maxlen smove maxlen swap addr over ; : chat-prev-line ( max span addr pos1 -- max span addr pos2 false ) line-date 64@ 64#-1 64= IF |
︙ | ︙ | |||
1174 1175 1176 1177 1178 1179 1180 | also net2o-base \ chain messages to one previous message : chain, ( msgaddr u -- ) [: 2dup startdate@ 64#0 { 64^ sd } sd le-64! sd 1 64s forth:type c:0key sigonly@ >hash hashtmp hash#128 forth:type ;] $tmp $, msg-chain ; : ?chain, ( -- ) chain-mode @ 0= ?EXIT | < | | | | 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 | also net2o-base \ chain messages to one previous message : chain, ( msgaddr u -- ) [: 2dup startdate@ 64#0 { 64^ sd } sd le-64! sd 1 64s forth:type c:0key sigonly@ >hash hashtmp hash#128 forth:type ;] $tmp $, msg-chain ; : ?chain, ( -- ) chain-mode @ 0= ?EXIT msg-group-o .msg:log[] $[]# 1- dup 0< IF drop ELSE msg-group-o .msg:log[] $[]@ chain, THEN ; : (send-avalanche) ( xt -- addr u flag ) [: 0 >o [: sign[ msg-start execute ?chain, msg> ;] gen-cmd$ o> +last-signed msg-log, ;] [group] ; previous : send-avalanche ( xt -- ) otr-mode @ IF now>otr ELSE now>never THEN |
︙ | ︙ | |||
1216 1217 1218 1219 1220 1221 1222 | ['] nick>chat arg-loop ; \ do otrify also net2o-base : do-otrify ( n -- ) >r | | | 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 | ['] nick>chat arg-loop ; \ do otrify also net2o-base : do-otrify ( n -- ) >r msg-group$ $@ >group msg-group-o .msg:log[] $@ r> cells safe/string IF $@ 2dup + sigpksize# - sigpksize# over keysize pkc over str= IF keysize /string 2swap new-otrsig 2swap $, $, msg-otrify ELSE 2drop 2drop ." not your message!" forth:cr THEN |
︙ | ︙ | |||
1379 1380 1381 1382 1383 1384 1385 | : /chats ( addr u -- ) 2drop ." ===== chats: " \U chats list chats \G chats: list all chats [: msg:name$ msg-group$ $@ str= IF ." *" THEN msg:name$ .group ." [" msg:peers[] $[]# 0 .r ." ]#" | | | 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 | : /chats ( addr u -- ) 2drop ." ===== chats: " \U chats list chats \G chats: list all chats [: msg:name$ msg-group$ $@ str= IF ." *" THEN msg:name$ .group ." [" msg:peers[] $[]# 0 .r ." ]#" msg:log[] $[]# u. ;] group#map ." =====" forth:cr ; : /nat ( addr u -- ) 2drop \U nat list NAT info \G nat: list nat traversal information of all peers in all groups \U renat redo NAT traversal \G renat: redo nat traversal |
︙ | ︙ | |||
1428 1429 1430 1431 1432 1433 1434 | \U n2o <cmd> execute n2o command \G n2o: Execute normal n2o command : /sync ( addr u -- ) \U sync [+date] [-date] synchronize logs \G sync: synchronize chat logs, starting and/or ending at specific \G sync: time/date | > | | | | 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 | \U n2o <cmd> execute n2o command \G n2o: Execute normal n2o command : /sync ( addr u -- ) \U sync [+date] [-date] synchronize logs \G sync: synchronize chat logs, starting and/or ending at specific \G sync: time/date s>unumber? IF drop ELSE 2drop 0 THEN cells >r msg-group-o .msg:peers[] $@ r@ u<= IF drop rdrop EXIT THEN r> + @ >o o to connection ." === sync ===" forth:cr net2o-code expect-msg [: msg-group last?, ;] [msg,] end-code o> ; : /version ( addr u -- ) \U version version string \G version: print version string 2drop .n2o-version space .gforth-version forth:cr ; : /log ( addr u -- ) \U log [#lines] show log \G log: show the log, default is a screenful s>unumber? IF drop >r ELSE 2drop rows >r THEN msg-group$ $@ >group purge-log r> display-lastn ; : /logstyle ( addr u -- ) \U logstyle [+-style] set log style \G logstyle: set log styles, the following settings exist: \G logstyle: +date a date per log line \G logstyle: +num a message number per log line |
︙ | ︙ | |||
1546 1547 1548 1549 1550 1551 1552 | : avalanche-text ( addr u -- ) >utf8$ [: parse-text ;] send-avalanche ; previous : load-msgn ( addr u n -- ) | | | 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 | : avalanche-text ( addr u -- ) >utf8$ [: parse-text ;] send-avalanche ; previous : load-msgn ( addr u n -- ) >r load-msg r> display-lastn ; : +group ( -- ) msg-group$ $@ >group +unique-con ; : msg-timeout ( -- ) packets2 @ connected-timeout packets2 @ <> IF reply( ." Resend to " pubkey $@ key>nick type cr ) timeout-expired? IF |
︙ | ︙ | |||
1615 1616 1617 1618 1619 1620 1621 | ELSE nip nip THEN ;] $[]map ; : key>group ( addr u -- pk u ) @/ 2swap tuck msg-group$ $! 0= IF 2dup key| msg-group$ $! THEN ; \ 1:1 chat-group=key : ?load-msgn ( -- ) | | | 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 | ELSE nip nip THEN ;] $[]map ; : key>group ( addr u -- pk u ) @/ 2swap tuck msg-group$ $! 0= IF 2dup key| msg-group$ $! THEN ; \ 1:1 chat-group=key : ?load-msgn ( -- ) msg-group$ $@ >group msg-group-o .msg:log[] $@len 0= IF msg-group$ $@ rows load-msgn THEN ; : chat-connects ( -- ) chat-keys [: key>group ?load-msgn dup 0= IF 2drop msg-group$ $@ >group EXIT THEN 2dup search-connect ?dup-IF >o +group greet o> 2drop EXIT THEN 2dup pk-peek? IF chat-connect ELSE 2drop THEN ;] $[]map ; |
︙ | ︙ | |||
1736 1737 1738 1739 1740 1741 1742 | REPEAT 2drop leave-chats xchar-history nr> set-order ; : avalanche-to ( addr u o:context -- ) avalanche( ." Send avalanche to: " pubkey $@ key>nick type space over hex. cr ) o to connection net2o-code expect-msg message | | | 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 | REPEAT 2drop leave-chats xchar-history nr> set-order ; : avalanche-to ( addr u o:context -- ) avalanche( ." Send avalanche to: " pubkey $@ key>nick type space over hex. cr ) o to connection net2o-code expect-msg message msg-group-o .msg:name$ 2dup pubkey $@ key| str= IF 2drop ELSE group, THEN $, nestsig end-with end-code ; \\\ Local Variables: forth-local-words: ( |
︙ | ︙ |
Changes to vault.fs.
︙ | ︙ | |||
102 103 104 105 106 107 108 | $80 Constant min-align# $400 Constant pow-align# : vault-aligned ( len -- len' ) \G Align vault to minimum granularity plus relative alignment \G to hide the actual file-size | | | 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 | $80 Constant min-align# $400 Constant pow-align# : vault-aligned ( len -- len' ) \G Align vault to minimum granularity plus relative alignment \G to hide the actual file-size 1- 0 >r BEGIN dup pow-align# u> WHILE 1 rshift r> 1+ >r REPEAT 1+ r> lshift min-align# 1- + min-align# negate and ; Variable enc-mode : enc-keccak ( -- ) $60 enc-mode ! ; \ wrap with keccak : enc-threefish ( -- ) $010160 enc-mode ! ; \ wrap with threefish : enc>crypt2 ( -- ) |
︙ | ︙ |